我是VBA的新手。如何根据col D和col F中的值拆分整行?我有大约1,200行。
注意:我希望在同一张表中替换旧值。
My Old Sheet看起来像这样:
multipart/form-data
预期的表格应如下所示
A B C D E F G H
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
编辑:
这是我尝试编码的方式:
A B C D E F G H
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
似乎有些搞砸了。我没有得到理想的结果。我无法复制该行的其他值。
非常感谢任何帮助。 提前谢谢。
答案 0 :(得分:0)
我认为最简单的方法是创建一个全新的工作表,根据需要添加行。
这样的事情应该有效:
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
- 2016年4月4日编辑 -
在回复您的评论时,我认为如果您想要拆分列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