Question

在我的工作中，我有两个具有相同产品的数据库。第一个数据库包含具有所有可能组合的所有产品（在此数据库中，数据库由电机排气组成，可提供不同颜色和材料）。第二个数据库仅包含基本产品。组合的产品ID与基础产品的ID对应。包含基本产品的数据库还包含大量有关产品的信息。

示例数据组合

- Product ID - Reference number
1.12012        E3A02ET7
2.12012        E3A02EN7
3.12013        E3A02ES6
4.12014        E9A03ES
5.12014        E9A03EN

示例数据库

- Product ID - Name     -     Price - Reference number
1.12012        Gilera Fuoco   €363    E3A02ET
2.12013        Gilera Nexus   €363    E3A02ES
3.12014        Gilera Runner  €363    E9A03EN

首选输出

 - Product ID - Name     -     Price - Reference number
1. 12012        Gilera Fuoco   €363    E3A02ET7
2. 12012        Gilera Fuoco   €363    E3A02EN7
3. 12013        Gilera Nexus   €363    E3A02ES6
4. 12014        Gilera Runner  €363    E9A03ES
5. 12014        Gilera Runner  €363    E9A03EN

由于我想将每个产品上传到我的网上商店，我需要以与基础产品数据库相同的方式格式化组合数据库，并提供所有有用的信息。我想这样做的方法是，如果组合产品的ID与基本产品的ID匹配，则使用仅复制组合产品参考编号的宏与整个基础产品行。由于许多组合产品匹配相同的基本产品ID，因此宏需要多次复制数据。此外，组合数据库还有关于另一个冒号中排气材料和颜色的信息（我将其排除在外，以使我的样本数据库不那么混乱）。如果可能，我想将此信息添加到产品名称中。

这就是我现在所拥有的：

Sub CopyYes()
    Dim c As Range
    Dim j As Long
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim Condition As Worksheet


    Set Source = ActiveWorkbook.Worksheets("Blad2")
    Set Target = ActiveWorkbook.Worksheets("Blad3")
    Set Condition = ActiveWorkbook.Worksheets("Blad1")

    j = 1    
      For Each d In Condition.Range("A1:A86")
        For Each c In Source.Range("A1:A893")
            If d = c Then
                Source.Rows(c.Row).Copy Target.Rows(j)
                j = j + 1
            End If
        Next c
      Next d
End Sub

很有责任，

B中。范斯塔肯堡

Answer 1

这很有效。只需将三个工作表重命名为A，B和C。

Option Explicit

Sub TestMe()

    Dim lngCounter      As Long
    Dim a               As Long '- do not name like this

    Dim rngCell         As Range
    Dim rngCell2        As Range

    Dim rngSource       As Range

    With Worksheets("B")
        Set rngSource = .Range(.Cells(1, 1), .Cells(5, 1))
    End With

    Worksheets("C").Cells.Clear

    With Worksheets("A")

    For Each rngCell In .Range(.Cells(1, 1), .Cells(5, 1))
        For Each rngCell2 In rngSource
            If rngCell2 = rngCell Then
                a = a + 1
                Worksheets("C").Rows(a).Value = Worksheets("B").Rows(rngCell2.Row).Value
                Worksheets("C").Cells(a, 4) = rngCell.Offset(0, 1)
            End If
        Next rngCell2
    Next rngCell

    End With

End Sub

结果如下：

为了使代码更加可行，请确保使用变量创建范围和数组。

是否有一个宏来有条件地将数据复制到另一个工作表？

1 个答案: