有没有macros有条件地将数据复制到另一个工作表？
在我的工作中，我有两个相同产品的数据库。 第一个数据库包含所有可能组合的产品（在这个数据库中，数据库由电机废气组成，可以使用不同的颜色和材料）。 第二个数据库只包含基本产品。 组合的产品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匹配，则使用只复制组合产品参考号和整个基本产品行的macros。 由于许多组合产品匹配相同的基本产品ID，所以macros需要多次复制数据。 另外，组合数据库还有另外一个冒号的废气材料和颜色的信息（我把它排除在外，这样我的样品数据库就不那么乱了）。 如果可能的话，我想将这些信息添加到产品名称中。
这是我现在所拥有的：
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. van Starkenburg
这工作。 只需将这三个工作表重命名为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
这是结果：
要使代码更加可行，请确保使用variables创build范围和数组。