0

私は Visual Basic に非常に慣れていないため、これが基本的な質問である場合は申し訳ありません。

私は 2 つの Excel ドキュメントを持っています。1 つは会社名とそれに対応する識別番号 (合計で約 4000) のリストです。別のドキュメントに、人々と彼らが働いている人のリストがあります (これらは最初のドキュメントと同じ会社ですが、その会社の複数の人と仕事をしているため、会社ごとに複数の行がある場合があります) ）。ここには約7000のエントリがあります。すべての会社 ID 番号を、会社のすべての従業員と一緒にドキュメントに転送したいと考えています。コードの概念は理解できましたが、残念ながらこれを書くには Excel の VBA 構文について十分な知識がありません。いくつかのコードを書きましたが、うまくいかず、理由がわかりません。

Sub Firm_Number_Transfer()
    Dim i As Integer
    Dim x As Integer
    Dim row As Integer
    Dim oldRow As Integer
    Dim found As Boolean

    row = 1
    oldRow = 1

    For i = Workbooks("PM Firm Contacts - Step 2 - REVIEWED").Worksheets("Sheet2").Cells("B1") To Workbooks("PM Firm Contacts - Step 2 - REVIEWED").Worksheets("Sheet2").Cells("B7122") Step 1
        row = row + 1
        For x = Workbooks("PM Firms - Step 1 - REVEIWED").Sheets("Sheet1").Cells("B2") To Workbooks("PM Firms - Step 1 - REVEIWED").Sheets("Sheet1").Cells("B4843") Step 1
            oldRow = oldRow + 1
            If i = x Then
                Workbooks("PM Firm Contacts - Step 2 - REVIEWED").Sheets("Sheet2").Cells(row, 1) = Workbooks("PM Firm Contacts - Step 2 - REVIEWED").Sheets("Sheet2").Cells(oldRow, 1)
                found = True
            End If
        Next x
        found = False
        oldRow = 1
    Next i
End Sub

私が行方不明であることは明らかですか？どんな助けでも大歓迎です。

編集

また、表は会社が右側にあり、会社番号が左側にあるように設定されていることも付け加えておきます。私が理解していることからVLOOKUP()、会社が左側にあり、コピーしている会社番号が右側にある場合にのみ機能します。それ以外の場合VLOOKUP()は、私が使用するものになります。

4

2 に答える 2

1

これで始められるはずです。If ブロック内のステートメントはタイプミスでしたか? あるワークブック/ワークシートから別のワークブック/ワークシートに (同じものからではなく) コピーするつもりだったのではないでしょうか?

Sub Firm_Number_Transfer()
        Dim i As Integer
        Dim x As Integer
        Dim row As Integer
        Dim oldRow As Integer
        Dim found As Boolean
        Dim xlBook As Workbook, xlBook2 As Workbook
        Dim xlSheet As Worksheet, xlSheet2 As Worksheet
        Dim rng As Range, cell As Range, rng2 As Range, cell2 As Range

    xlBook2 = Workbooks("PM Firms - Step 1 - REVEIWED")
    xlSheet2 = xlBook2.Worksheets("Sheet1")
    Set rng2 = xlSheet2.Range("B2:B4843")

    xlBook = Workbooks("PM Firm Contacts - Step 2 - REVIEWED")
    xlSheet = xlBook.Worksheets("Sheet2")
    Set rng = xlSheet.Range("B1:B7122")

    row = 1
    oldRow = 1

    For Each cell In rng
        row = row + 1
        For Each cell2 In rng2
            oldRow = oldRow + 1
            If cell.Value2 = cell2.Value2 Then
                xlSheet.Cells(row, 1) = xlSheet.Cells(oldRow, 1)
                found = True
            End If

        Next
        found = False
        oldRow = 1

    Next

End Sub
于 2013-07-23T14:35:53.310 に答える