0

したがって、私がやろうとしているのは、2 つの列をループすることです。列 1 のセルに値がある場合は、別のシートでその値を見つけ、その行全体を取得し、別のシートに貼り付けてから、列 1 の値に隣接する列 2 のセルの値を入力し、その行を同じシートに貼り付けます。

したがって、「Common Build」の列 1 が 12345 に等しい場合、「S&OP Final Sheet」で 12345 を検索し、その行全体を取得して「Common Build Projects」に貼り付け、「Common build」の 2 列目に移動します。 (=12346) これらの値を検索し、その行を「Common Build Projects」に貼り付け、2 列目から次の空白まで下に移動します。目標は、ユーザーがプロジェクトのリストに入力し、それに基づいてそれを読み取らせることです。毎回同じようにフォーマットされるので、問題はありません。終了して次の行に移動できるように、それぞれの間に空白を残しました。

コードは正常に実行されますが、値を取得できません。時計を追加しましたが、何も起こりません。一致するリストは数千行の長さなので、一致するまですべてを調べることはできません。

リストはそのようにフォーマットされています（コードを表示させる唯一の方法でした。これが適切なフォーマットでない場合は申し訳ありません）

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

まず、2 つの列を配列に読み込むことをお勧めします。

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

まず、次のようなRange("A2:A" And lastrow)ことはできません。次のように、文字列連結演算子 ' &'を使用する必要がありますRange("A2:A" & lastrow)。これがいくつか発生しています。
次に、コードをインデントしてください。適切にインデントされたコードは、非常に読みやすく維持しやすいものです。

于 2013-08-06T15:51:23.177 に答える