根据vba，excel中两行的值拆分表中的两行
我是VBA新手。 如何根据col D和col F中的值拆分整行？ 我有大约1200行。
注意：我正在寻找replace在同一张表中的旧值。
我的旧表看起来像这样：
ABCDEFGH 9/9/2015 9:54 500 glass 2 1 590 ABC 123 NULL 6/8/2015 8:55 501 glass 3 to 4 1 400 to 500 XYZ 259 NULL 5/8/2015 8:55 502 glass 1 to 2 1 675 to 750 J8H 1X4 NULL 1/11/2015 9:55 503 glass Base to 2 1 425 to 575 J1K 2N1 NULL 1/1/2015 8:55 504 glass 3 2 1030 to 1050 H7G 3B5 NULL 16/1/2015 9:55 505 glass 2 2 1600 to 1800 H7W 5E4 NULL 预期的工作表应该是这样的
ABCDEFGH 9/9/2015 9:54 500 glass 2 1 590 ABC 123 NULL 6/8/2015 8:55 501 glass 3 1 400 XYZ 259 NULL 6/8/2015 8:55 501 glass 4 1 500 XYZ 259 NULL 5/8/2015 8:55 502 glass 1 1 675 ABC 123 NULL 5/8/2015 8:55 502 glass 2 1 750 ABC 123 NULL 1/11/2015 9:55 503 glass Base 1 425 ABC 123 NULL 1/11/2015 9:55 503 glass 2 1 575 ABC 123 NULL 1/1/2015 8:55 504 glass 3 2 1040 ABC 123 NULL 16/1/2015 9:55 505 glass 2 2 1700 ABC 123 NULL
- 当col分解成两个。 D =范围，（第2行（旧表））
- 当D和F都是范围时，分割（第3行和第4行（旧表））
- 以F为范围取平均值。 （第5行和第6行（旧纸））
- 否则忽略。 （第1行（旧纸））
编辑：
这是我试图编码它：
Sub Split() Dim cl As Range, x&, z&, k Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary") With ActiveSheet 'replace `activesheet` by `sheets("specifysheetname")` if required x = .Cells(.Rows.Count, "D").End(xlUp).Row: z = 1 For Each cl In .Range("D1:D" & x) If LCase(cl.Value2) Like "*to*" And _ LCase(cl.Offset(, 1).Value2) Like "*to*" Then Dic.Add z, Split(cl.Value2)(0) & ";" & Split(cl.Offset(, 1).Value2)(0): z = z + 1 Dic.Add z, Split(cl.Value2)(2) & ";" & Split(cl.Offset(, 1).Value2)(2) ElseIf Not (LCase(cl.Value2) Like "*to*") And _ LCase(cl.Offset(, 1).Value2) Like "*to*" Then Dic.Add z, cl.Value2 & ";" & Application.Average(Split(cl.Offset(, 1).Value)(0), _ Split(cl.Offset(, 1).Value)(2)) Else Dic.Add z, cl.Value2 & ";" & cl.Offset(, 1).Value2 End If z = z + 1 Next cl For Each k In Dic .Cells(k, "D").Value2 = Split(Dic(k), ";")(0) .Cells(k, "F").Value2 = Split(Dic(k), ";")(1) Next k End With End Sub
似乎有点搞砸了。 我没有得到预期的结果。 我有困难复制行的其他值。
任何帮助深表感谢。 提前致谢。
我认为最简单的做法是创build一个全新的表格，根据需要添加行。
像这样的东西应该工作：
Dim ws1, ws2 As Worksheet Dim row2 As Integer Dim rw As Range Dim dv, fv As Variant Set ws1 = Sheets("Sheet1") Set ws2 = Sheets.Add row2 = 1 For Each rw In ws1.Rows If rw.Cells(1, 1).Value2 = "" Then Exit For End If dv = Split(rw.Cells(1, 4).Value2, " to ") fv = Split(rw.Cells(1, 6).Value2, " to ") ws2.Cells(row2, 1).EntireRow.Value = rw.Value If UBound(dv) = 0 Then If UBound(fv) = 1 Then ws2.Cells(row2, 6).Value2 = (Val(fv(0)) + Val(fv(1))) / 2 End If Else ws2.Cells(row2, 4).Value2 = dv(0) ws2.Cells(row2, 6).Value2 = fv(0) row2 = row2 + 1 ws2.Cells(row2, 1).EntireRow.Value = rw.Value ws2.Cells(row2, 4).Value2 = dv(1) ws2.Cells(row2, 6).Value2 = fv(UBound(fv)) End If row2 = row2 + 1 Next rw
然后，最后，将新工作表中的数据复制到旧工作表中并删除。
ws1.Rows("1:" & row2).Value = ws2.Rows("1:" & row2).Value Application.DisplayAlerts = False ws2.Delete Application.DisplayAlerts = True
– 编辑11/4/2016 –
为了回应你的评论，我想这是你想要做的，如果你想分裂列F的价值而不是平均。
我基本上劫持了我用来分割D列的代码
If UBound(dv) = 0 Then If UBound(fv) = 1 Then ws2.Cells(row2, 4).Value2 = dv(0) ws2.Cells(row2, 6).Value2 = fv(0) row2 = row2 + 1 ws2.Cells(row2, 1).EntireRow.Value = rw.Value ws2.Cells(row2, 4).Value2 = dv(0) ws2.Cells(row2, 6).Value2 = fv(UBound(fv)) End If Else ws2.Cells(row2, 4).Value2 = dv(0) ws2.Cells(row2, 6).Value2 = fv(0) row2 = row2 + 1 ws2.Cells(row2, 1).EntireRow.Value = rw.Value ws2.Cells(row2, 4).Value2 = dv(1) ws2.Cells(row2, 6).Value2 = fv(UBound(fv)) End If