2

作为记录，我是一个未经训练的、仅录制宏的 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 等，但我不知道足够的语法来开始实现任何东西。建议？

4

1 回答 1

0 
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
于 2013-09-19T00:00:16.193 回答