作为记录,我是一个未经训练的、仅录制宏的 VBA 用户。我试着在这里和那里收集点点滴滴,但我仍然是个菜鸟。请指出我正确的方向!
在每一行,零件编号(E 列)应与源和地址(G 和 H 列)和描述(I 列)相关联。我说“应该”,但实际上,在许多文件中,某些行上最多有 15 个不同的源/地址组合,而不是每个部件号有一个源/地址组合,源/地址组合列在相邻的J/K、L/M、N/O 等列,将描述列推到右侧。
我需要找到一种 VB 方法来复制行的次数与源/地址组合的次数一样多,并且每行只删除一个组合。这是一个例子:
A B C D Part# F Source1 Address1 Source2 Address2 Description
1 x x x x Part1 x (S1) (A1) Nut
2 x x x x Part2 x (S1) (A1) (S2) (A2) Bolt
第 2 行有两个源/地址组合,需要复制,每行只有一个组合,如下所示:
A B C D Part# F Source Address Description
1 x x x x Part1 x (S1) (A1) Nut
2 x x x x Part2 x (S1) (A1) Bolt
3 x x x x Part2 x (S2) (A2) Bolt
在另一个文件中,我可能在任何给定行上最多有十五个不同的源/地址组合,然后需要复制十五次。
这有意义吗?在我的脑海中,我听到了我从未使用过的 VBA 函数,如循环、do-while、do-until 等,但我不知道足够的语法来开始实现任何东西。建议?
最佳答案
Sub Test()
Dim rw As Range, rwDest As Range, cellSrc As Range
Dim colDesc As Long, f As Range
colDesc = 0
'see if we can find the "description" column header
Set f = Sheet1.Rows(1).Find(what:="Description", LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then colDesc = f.Column
Set rw = Sheet1.Rows(2)
Do While Len(rw.Cells(, "E").Value) > 0
Set cellSrc = rw.Cells(, "G")
Do While Len(cellSrc.Value) > 0 And _
UCase(Sheet1.Rows(1).Cells(cellSrc.Column).Value) Like "*SOURCE*"
Set rwDest = Sheet2.Cells(Rows.Count, "E").End(xlUp). _
Offset(1, 0).EntireRow
rw.Cells(1).Resize(1, 6).Copy rwDest.Cells(1)
cellSrc.Resize(1, 2).Copy rwDest.Cells(7)
If colDesc > 0 Then rw.Cells(colDesc).Copy rwDest.Cells(9)
Set cellSrc = cellSrc.Offset(0, 2)
Loop
Set rw = rw.Offset(1, 0)
Loop
End Sub
关于vba - 在 Excel VBA 中,根据列数据创建新行,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/18883725/