excel - Excel VBA 比较两个工作表并将某些单元格输出到一个新的

Question

我已经尝试了几个小时来做​​到这一点，但不是 VBScript 的专家，我想我需要一点帮助。

这就是我所反对的。我有 2 个不同的工作表，其中包含一些相同的信息。

WORKSHEET1
Section/Dept    City    Building    SVD User Name   Item Short Code Item Full Name      SUPPLIER_SC Serial Number       IP Address  Product Class   Product     Item Status
BT&IT-         WINNIPEG GATEWAY CO  IT NETWORK      CHK0639V1JX     07JACM401093000MSYS000  CISCO   WNPIMBTVBBN-DSTH    1.2.3.4     SWITCHES       3550-24       ACTIVE

WORKSHEET2
Hostname           Management IP    Device Type        Vendor   Model           Software Version    Serial Number   Location    In Site
wnpimbtvbbn-dsth    1.2.3.4          Cisco IOS Switch   Cisco   catalyst355024  12.1(11)EA1        CHK0639V1JX     Gateway CO   Entire Network\Winnipeg\MTS TV Head End\

我想要做的是将两者关联起来并输出到第三个，以便重新组织信息以导入数据库。基本上，如果在 WORKSHEET1 的“项目短代码/项目全名/序列号”中的任何一个中找到“主机名”表单 WORKSHEET2，我想输出“sheet1.item 短代码”，然后从 SHEET2 输出整行，但在不同的命令。此外，如果未找到匹配项，则从 SHEET2 输出整行...

据我所知，这大约是：

Sub CompareandOutput()
    Dim inv1 As Range
    Dim Assyst1 As Range
    Dim Assyst2 As Range
    Dim Assyst3 As Range
    Dim Inventory1Items As Range
    Dim Assyst1Items As Range
    Dim Assyst2Items As Range
    Dim Assyst3Items As Range
    Sheet3.Cells.Clear


    Set Inventory1Items = Sheet2.Range("A2", Sheet2.Range("A65536").End(xlUp))
    Set Assyst1Items = Sheet1.Range("E4", Sheet1.Range("E65536").End(xlUp))
    Set Assyst2Items = Sheet1.Range("F4", Sheet1.Range("F65536").End(xlUp))
    Set Assyst3Items = Sheet1.Range("H4", Sheet1.Range("H65536").End(xlUp))

    Sheet3.Range("A1") = "Old Short Code"
    Sheet3.Range("B1") = "New Short Code"
    Sheet3.Range("C1") = "New Full Name"
    Sheet3.Range("D1") = "Serial Number"
    Sheet3.Range("E1") = "Version"
    Sheet3.Range("F1") = "IP Address"
    Sheet3.Range("G1") = "Supplier"
    Sheet3.Range("H1") = "Product Class"
    Sheet3.Range("I1") = "Product"
    For Each inv1 In Inventory1Items
        Sheet3.Range("B65536").End(xlUp).Offset(1, 0) = inv1.Value
        Set Assyst1 = Assyst1Items.Find(inv1, LookIn:=xlValues, lookat:=xlWhole)
        If Not Assyst1 Is Nothing Then
        Sheet3.Range("A65536").End(xlUp).Offset(0, 0) = Cells(Assyst1.Row, "E")
        Sheet3.Range("C65536").End(xlUp).Offset(0, 0) = inv1.Value
        'Sheet3.Range("D65536").End(xlUp).Offset(1, 0) = Sheet2(Cells(Assyst1.Row, "D")).Select
        End If
        'Set Assyst2 = Assyst2Items.Find(inv1, LookIn:=xlValues, lookat:=xlWhole)
        'If Not Assyst2 Is Nothing Then
        'Sheet3.Range("B65536").End(xlUp).Offset(1, 0) = inv1.Row
        'End If
        'Set Assyst3 = Assyst3Items.Find(inv1, LookIn:=xlValues, lookat:=xlWhole)
        'If Not Assyst3 Is Nothing Then
        'Sheet3.Range("B65536").End(xlUp).Offset(1, 0) = inv1.Row
        'End If
    Next inv1


End Sub

我确定我在这里完全偏离了轨道，并且有一种更简单的方法可以做到这一点。任何帮助都将不胜感激。

---

好的是的......仍然需要帮助。取得了重大进展，但只有最后一件小事不起作用。基本上我一辈子都无法获得函数 CheckForMatch，将其结果“itemShortCode”传递给私有子“exporttonewworksheet”。一切正常，直到函数结束，主子和导出子似乎没有得到值。我确定我在这里不理解一些基本的东西......

Public Enum Assyst1Columns
    Section_Dept = 1
    City
    Building
    SVD_User_Name
    Item_Short_Code
    Item_Full_Name
    SUPPLIER_SC
    Serial_Number
    IP_Address
    Product_Class
    Product
    Item_Status
End Enum

Public Enum Inventory1Columns
    Hostname = 1
    Management_IP
    Device_Type
    Vendor
    Model
    Software_Version
    Serial_Number
    Location
    In_Site
End Enum
Public Sub main()
    Dim Assyst As Excel.Worksheet
    Dim Inventory As Excel.Worksheet
    Dim Output As Excel.Worksheet
    Set Assyst = ThisWorkbook.Worksheets("Assyst")
    Set Inventory = ThisWorkbook.Worksheets("Inventory")
    Dim InventoryItems As Range
    Sheet3.Cells.Clear

    'Set Output1 = ThisWorkbook.Worksheets.Add

    'Output1.Name = "Output1"

    Dim newWkRow As Long
    newWkRow = 1


    Dim test As String
    Set InventoryItems = Inventory.Range("A2", Inventory.Range("A65536").End(xlUp))
    ' loop through wk2
    For Each hname In InventoryItems
        ' for each wk2.Cell found, call checkForMatch()
        ' store checkForMatch() value into variable
        itemShortCode = checkForMatch(hname, Assyst)
        'Sheet3.Range("A65536").End(xlUp).Offset(1, 0) = hname
        ' export to new worksheet
        test = itemShortCode

        exportToNewWorksheet Output, Inventory, hname.Row, newWkRow, itemShortCode

        newWkRow = newWkRow + 1 ' the only reason for newWkRow is if you want to skip any
                                ' entries from WORKSHEET2. So it's best to keep this count separate
                                ' from your current loop row

    Next
End Sub

Private Function checkForMatch(ByVal hname As String, ByRef Assyst As Excel.Worksheet) As String
    ' PLEASE NOTE: wk1 does NOT need to match in the function definition to that of the
    '               variable defined in main()
    ' search for match from Inventory to Assyst
    Dim item As String
    Dim test As String
    Dim matches As String
    Dim Assyst1Items As Range
    Set Assyst1Items = Assyst.Range("A4", Assyst.Range("L65536").End(xlUp))

    On Error Resume Next
    matches = Assyst1Items.Find(hname, LookIn:=xlValues, lookat:=xlWhole)

    ' if found, return the Item_Short_Code
    If Not matches = "" Then
        item = matches
    ' otherwise return vbNullString
    Else
        item = vbNullString
    End If
    itemShortCode = item
End Function

Private Sub exportToNewWorksheet(ByRef Output As Excel.Worksheet, _
                                ByRef Inventory As Excel.Worksheet, _
                                ByRef hname As Long, _
                                ByVal newWkRow As Long, _
                                Optional ByVal itemShortCode As String = vbNullString)

    ' put data into new row. be sure to use the Enum to re-order the column as you like
    If itemShortCode = "" Then
        Sheet3.Cells(newWkRow, 2).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 3).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 4).Value = Inventory.Cells(hname, Inventory1Columns.Management_IP).Value
        Sheet3.Cells(newWkRow, 5).Value = Inventory.Cells(hname, Inventory1Columns.Device_Type).Value
        Sheet3.Cells(newWkRow, 6).Value = Inventory.Cells(hname, Inventory1Columns.Vendor).Value
        Sheet3.Cells(newWkRow, 7).Value = Inventory.Cells(hname, Inventory1Columns.Model).Value
        Sheet3.Cells(newWkRow, 8).Value = Inventory.Cells(hname, Inventory1Columns.Software_Version).Value
        Sheet3.Cells(newWkRow, 9).Value = Inventory.Cells(hname, Inventory1Columns.Serial_Number).Value
    Else
        ' store data another way
        Sheet3.Cells(newWkRow, 1).Value = Assyst.Cells(hname, Assyst1Columns.Item_Short_Code).Value
        Sheet3.Cells(newWkRow, 2).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 3).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 4).Value = Inventory.Cells(hname, Inventory1Columns.Management_IP).Value
        Sheet3.Cells(newWkRow, 5).Value = Inventory.Cells(hname, Inventory1Columns.Device_Type).Value
        Sheet3.Cells(newWkRow, 6).Value = Inventory.Cells(hname, Inventory1Columns.Vendor).Value
        Sheet3.Cells(newWkRow, 7).Value = Inventory.Cells(hname, Inventory1Columns.Model).Value
        Sheet3.Cells(newWkRow, 8).Value = Inventory.Cells(hname, Inventory1Columns.Software_Version).Value
        Sheet3.Cells(newWkRow, 9).Value = Inventory.Cells(hname, Inventory1Columns.Serial_Number).Value
        ' etc...
    End If
End Sub

Answer 1

我怀疑有一种简单的方法可以做到这一点。据我了解，您想尝试在另一个工作表的 3 个可能列中匹配一个工作表中的值，然后将两个工作表中的某些数据输出到新工作表。我真的没有看到一个聪明、简单的方法来做到这一点。

但是，这里有一些建议。请原谅我陈述您已经知道的项目，因为它接缝您确实知道如何编程：

利用 Enum 查找并重新排序复制的数据

例子：

Public Enum wks1Columns
    Section_Dept = 1
    City
    Building
    SVD_User_Name
    Item_Short_Code
    etc
End Enum

Public Enum wks2Columns
    Hostname = 1
    Management_IP
    Device_Type
    etc
End Enum

Public Sub test()
    Dim wk1 As Excel.Worksheet
    Dim wk2 As Excel.Worksheet
    Set wk1 = ThisWorkbook.Worksheets("WORKSHEET1")
    Set wk2 = ThisWorkbook.Worksheets("WORKSHEET2")

    ' imagine Building is in column 5 in WORKSHEET1 and SVD is in column 7 in WORKSHEET1
    ' but you wanted to put them in columns 1 and 2 in the new worksheet
    Sheet1.Cells(1, 1).Value = wk1.Cells(1, wks1Columns.Building).Value
    Sheet1.Cells(1, 2).Value = wk1.Cells(1, wks1Columns.SVD_User_Name).Value

    ' and you wanted stuff from WORKSHEET2 in the same row
    Sheet1.Cells(1, 3).Value = wk2.Cells(1, wks2Columns.Hostname).Value
End Sub

使用枚举，您可以存储已在工作表中设置列的方式，然后使用它们使用枚举方法轻松地重新排序新工作表。很酷的是，如果 Section Dept 的 WORKSHEET1 列移动到第 2 列和 City 到第 1 列，您只需要重新排序枚举和 BOOM，您就完成了修改代码；）

将您的功能分解为更小的任务

这绝对是您正在尝试执行的一项复杂任务，如果您将所有这些都放在一个大的Sub. 就像是：

Public Sub main()
    Dim wk1 As Excel.Worksheet
    Dim wk2 As Excel.Worksheet
    Dim wkNew As Excel.Worksheet
    Set wk1 = ThisWorkbook.Worksheets("WORKSHEET1")
    Set wk2 = ThisWorkbook.Worksheets("WORKSHEET2")
    Set wkNew = ThisWorkbook.Worksheets.Add

    wkNew.Name = "My New Worksheet"

    Dim newWkRow As Long
    newWkRow = 1

    Dim itemShortCode As String

    ' loop through wk2
    ' for each wk2.Cell found, call checkForMatch()
        ' store checkForMatch() value into variable
        itemShortCode = checkForMatch("my value", wk1)

        ' export to new worksheet
        exportToNewWorksheet wkNew, wk2, currentRowFromLoop, newWkRow, itemShortCode

        newWkRow = newWkRow + 1 ' the only reason for newWkRow is if you want to skip any
                                ' entries from WORKSHEET2. So it's best to keep this count separate
                                ' from your current loop row

    ' next
End Sub

Private Function checkForMatch(ByRef theValue As String, ByRef wk1 As Excel.Worksheet) As String
    ' PLEASE NOTE: wk1 does NOT need to match in the function definition to that of the
    '               variable defined in main()


    ' search for match from wk2 to wk1


    ' if found, return the Item_Short_Code
    ' otherwise return vbNullString

End Function

Private Sub exportToNewWorksheet(ByRef newWs As Excel.Worksheet, _
                                ByRef wk2 As Excel.Worksheet, _
                                ByRef wk2Row As Long, _
                                ByVal newRow As Long, _
                                Optional ByVal Item_Short_Code As String = vbNullString)

    ' put data into new row. be sure to use the Enum to re-order the column as you like
    If (Item_Short_Code <> vbNullString) Then
        ' store data one way
        ' ...
    Else
        ' store data another way
        newWs.Cells(newRow, 1).Value = Item_Short_Code
        newWs.Cells(newRow, 2).Value = wk2.Cells(wk2Row, wks2Columns.Hostname).Value
        ' etc...
    End If
End Sub

我想你可能会被这一切的语法所吸引。我在您的代码中看到的一些提示：

1. 完全限定您的范围对象。该Cell对象始终引用活动工作表的单元格，如果您从另一个工作表运行代码，它不会帮助您，而您并不打算这样做。
2. Offset(0,0)不做任何事情。.Value如果你想设置一个范围的值，只需使用
3. 如果您的主工作表的所有列的最后一行都相同，您可以将最后一行存储到一个变量中，并在后续的 Range 集中使用它
4. 我认为您之前已经编程过，如果是这样，您将直接浏览一些在线找到的 VBA 教程。值得付出努力，即使您的截止日期很紧。

希望这可以帮助

Answer 2

适用于任何可能试图做同样事情的人的工作代码。它不漂亮，但它有效。感谢约瑟夫的所有帮助和建议！！！

Public Enum Assyst1Columns
    Section_Dept = 1
    City
    Building
    SVD_User_Name
    Item_Short_Code
    Item_Full_Name
    SUPPLIER_SC
    Serial_Number
    IP_Address
    Product_Class
    Product
    Item_Status
End Enum

Public Enum Inventory1Columns
    Hostname = 1
    Management_IP
    Device_Type
    Vendor
    Model
    Software_Version
    Serial_Number
    Location
    In_Site
End Enum
Public Sub main()
    Dim Assyst As Excel.Worksheet
    Dim Inventory As Excel.Worksheet
    Dim Output As Excel.Worksheet
    Set Assyst = ThisWorkbook.Worksheets("Assyst")
    Set Inventory = ThisWorkbook.Worksheets("Inventory")
    Dim InventoryItems As Range
    Sheet3.Cells.Clear

    Sheet3.Range("A1") = "Old Item Short Code"
    Sheet3.Range("B1") = "New Item Short Code"
    Sheet3.Range("C1") = "New Item Full Name"
    Sheet3.Range("D1") = "IP Address"
    Sheet3.Range("E1") = "Product Class"
    Sheet3.Range("F1") = "Supplier"
    Sheet3.Range("G1") = "Product"
    Sheet3.Range("H1") = "Version"
    Sheet3.Range("I1") = "Serial Num"

    Dim newWkRow As Long
    newWkRow = 2


    Set InventoryItems = Inventory.Range("A2", Inventory.Range("A65536").End(xlUp))
    ' loop through Inventory Worksheet
    For Each hname In InventoryItems

        ' for each cell found, call checkForMatch()
        ' store checkForMatch() value into variable
        itemShortCode = checkForMatch(hname, Assyst)

        ' export to new worksheet
        exportToNewWorksheet Assyst, Inventory, hname.Row, newWkRow, itemShortCode

        newWkRow = newWkRow + 1 ' the only reason for newWkRow is if you want to skip any
                                ' entries from WORKSHEET2. So it's best to keep this count separate
                                ' from your current loop row

    Next
End Sub

Private Function checkForMatch(ByVal hname As String, ByRef Assyst As Excel.Worksheet) As String
    ' PLEASE NOTE: hname does NOT need to match in the function definition to that of the
    '               variable defined in main()
    ' search for match from Inventory to Assyst
    Dim matches As Range
    Dim Assyst1Items As Range
    Set Assyst1Items = Assyst.Range("A4", Assyst.Range("L65536").End(xlUp))

    On Error Resume Next
    Set matches = Assyst1Items.Find(hname, LookIn:=xlValues, lookat:=xlWhole)

    ' if found, return the Item_Short_Code
    If Not matches = "" Then
        checkForMatch = matches.Row

    ' otherwise return vbNullString
    Else
        checkForMatch = vbNullString
    End If

End Function

Private Sub exportToNewWorksheet(ByRef Assyst As Excel.Worksheet, _
                                ByRef Inventory As Excel.Worksheet, _
                                ByRef hname As Long, _
                                ByVal newWkRow As Long, _
                                Optional ByVal itemShortCode As String)

    'store data that's old but update data with Inventory ws
    If itemShortCode = "" Then
        Sheet3.Cells(newWkRow, 2).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 3).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 4).Value = Inventory.Cells(hname, Inventory1Columns.Management_IP).Value
        Sheet3.Cells(newWkRow, 5).Value = Inventory.Cells(hname, Inventory1Columns.Device_Type).Value
        Sheet3.Cells(newWkRow, 6).Value = Inventory.Cells(hname, Inventory1Columns.Vendor).Value
        Sheet3.Cells(newWkRow, 7).Value = Inventory.Cells(hname, Inventory1Columns.Model).Value
        Sheet3.Cells(newWkRow, 8).Value = Inventory.Cells(hname, Inventory1Columns.Software_Version).Value
        Sheet3.Cells(newWkRow, 9).Value = Inventory.Cells(hname, Inventory1Columns.Serial_Number).Value
    Else
        ' store data that's new (doesn't match)
        Sheet3.Cells(newWkRow, 1).Value = Assyst.Cells(itemShortCode, Assyst1Columns.Item_Short_Code).Value
        Sheet3.Cells(newWkRow, 2).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 3).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 4).Value = Inventory.Cells(hname, Inventory1Columns.Management_IP).Value
        Sheet3.Cells(newWkRow, 5).Value = Inventory.Cells(hname, Inventory1Columns.Device_Type).Value
        Sheet3.Cells(newWkRow, 6).Value = Inventory.Cells(hname, Inventory1Columns.Vendor).Value
        Sheet3.Cells(newWkRow, 7).Value = Inventory.Cells(hname, Inventory1Columns.Model).Value
        Sheet3.Cells(newWkRow, 8).Value = Inventory.Cells(hname, Inventory1Columns.Software_Version).Value
        Sheet3.Cells(newWkRow, 9).Value = Inventory.Cells(hname, Inventory1Columns.Serial_Number).Value
        ' etc...
    End If
End Sub