0

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

因此，如果“Common Build”中的第 1 列等于 12345，它将在“S&OP Final Sheet”中搜索 12345，取整行，将其粘贴到“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
4

3 回答 3

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
于 2013-08-06T15:51:05.267 回答
0

在我看来，这条线

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)
于 2013-08-06T18:53:24.563 回答
0

首先，诸如此类的事情是Range("A2:A" And lastrow)行不通的。您必须使用字符串连接运算符：' &'，如下所示：Range("A2:A" & lastrow)。你有几次出现这种情况。
其次，请缩进你的代码！正确缩进的代码更容易阅读和维护！

于 2013-08-06T15:51:23.177 回答