Question

我是Visual Basic的新手，所以如果这是一个基本问题我会道歉。

我有两个excel文档，一个包含公司名称列表及其相应的识别号码（总共约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()就是我要用的。

Answer 1

您可以使用VLOOKUP公式来避免代码：

在个人资料表中，添加目标列：

= VLOOKUP(PARAM1, PARAM2, Param3)

其中：

Param1 - 包含公司名称

的个人资料表中的单元格

Param2 - 公司工作表中的范围（从列到列，如A：C），从包含公司名称的列到包含其ID的列

Param3 - 列的索引包含与名称相关的ID（例如，如果ID在列C中，并且列A中的名称，索引是3 - 3列）

你把那个公式并把它拖到所有个人身上。

使用Index和Match

的其他选项

= index(IDColumn; match(CellWithCompanyNameInPersonelSheet; CompanyNameColumn; 0))

如果必须使用列，请在“B”列中添加类似“B：B”的内容。

Answer 2

这应该让你开始。 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

搜索匹配的单元格并复制行数据

2 个答案: