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 回答