Question

所以我要做的是遍历两列，如果第1列中的单元格中有一个值，在另一张纸上找到该值，然后取整行，并将其粘贴到另一张纸上，然后获取与第1列值相邻的第二列单元格中的值，并将该行粘贴到同一张纸上。

因此，如果“Common Build”中的第1列等于12345，它将搜索12345的“S＆amp; OP Final Sheet”，取整行，将其粘贴到“Common Build Projects”中，转到第二列在“Common build”（= 12346）中搜索这些值，然后将该行粘贴到“Common Build Projects”中，然后向下到第二列直到下一个空白。目标是用户可以输入包含项目的列表，并根据该项目读取它。它每次都会以相同的方式格式化，因此不会成为问题。我在每个之间留下了一个空白，以便它可以退出以进入下一行。

代码运行正常，我无法得到它来拉取值。我添加了手表，没有发生任何事情。匹配列表长达数千行，所以直到匹配才能完成。

列表的格式是这样的（代码是让它显示它的唯一方式，对不起，如果这不是正确的格式）

CB project Individual Project
12335      12336
blank      12337
blank      12338
blank      12339

12345      12346
blank      12347
blank      12348
blank      12349

这是我目前的代码：

Sub CommonBuilds()
Sheets("Common Build").Select
Dim lastrow As Long
Dim y As String
lastrow = Cells(Rows.Count, 1).End(xlUp).row
For Each c In Range("A2:A" & lastrow)
    y = Cells(c.row, 1).value
    If y <> "" Then
        Sheets("S&OP Final").Select
        lastrow2 = Cells(Rows.Count, 1).End(xlUp).row
        For Each c2 In Range("E2:E" & lastrow2)
            If Cells(c2.row, 5).value = y Then
                Cells(c2.row, 5).EntireRow.Copy
                Sheets("Common Build Projects").Select
                With Sheets("Common Build Projects")
                    .Rows(.Cells(Sheets("Common Build Projects").Rows.Count, 1).End(xlUp).row + 1).PasteSpecial xlPasteValues
                End With
            End If
        Next
        Sheets("Common Build").Select
        For Each c3 In Range("B2:B" & lastrow)
            z = Cells(c3.row, 2).value
            If z <> "" Then
            Sheets("S&OP Final").Select
                For Each c2 In Range("E2:E" & lastrow2)
                    If Cells(c2.row, 5).value = z Then
                        Cells(c2.row, 5).EntireRow.Copy
                        Sheets("Common Build Projects").Select
                        With Sheets("Common Build Projects")
                            .Rows(.Cells(Sheets("Common Build Projects").Rows.Count, 1).End(xlUp).row + 1).PasteSpecial xlPasteValues
                        End With
                    End If
                Next
            ElseIf z = "" Then
                Exit For
            End If
        Next
    End If
Next c
End Sub

Answer 1

我建议您首先将两列读入数组。

dim myarray() as variant

myarray = range("A2:E" & lastrow).value2

然后遍历E列值，寻找空白：

n = 2
cb_project = myarray(n,1)

do while n <= lastrow
    'copy row matching cb_project

    if myarray(n,5) = "" then
        cb_project = myarray(n+1,1)
    else
        'copy row matching myarray(n,5)
    endif

    n=n+1
loop

Answer 2

首先，像Range("A2:A" And lastrow)之类的东西无效。您必须使用字符串连接运算符：“&”，如下所示：Range("A2:A" & lastrow)。你有几次出现这种情况其次，请缩进你的代码！适当缩进的代码更容易阅读和维护！

Answer 3

在我看来，该行

lastrow = Cells(Rows.Count, 1).End(xlUp).row

找到第1列中的最后一行。不幸的是，如果我理解逻辑正确，你需要（需要）第2列中的最后一行 - 因为第2列中的值列表比第1列中的列表更进一步（或者至少这是我对你需要的解释）

For Each c3 In Range("B2:B" & lastrow)

换句话说 - 对于您提供的示例，您将只查找第二个项目的第一行（12346），而不是寻找任何进一步的匹配。这可能是你的问题吗？

解决方案是添加一行

lastBrow = Cells(Rows.Count, 2).End(xlUp).row

并将For循环更改为

For Each c3 In Range("B2:B" & lastBrow)

嵌套For Each语句

3 个答案: