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

【问题标题】：Excel VBA Compare two worksheets and output certain cells to a new oneExcel VBA 比较两个工作表并将某些单元格输出到一个新的
【发布时间】：2013-02-01 03:37:03
【问题描述】：

我已经尝试了几个小时来做这件事，但不是 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

【问题讨论】：

如果您更熟悉数据库，将这两个工作表导入数据库表、连接它们并将该信息输出到新表中可能会容易得多。这条评论是我逃避阅读你的代码并写一个答案，但如果我的建议对你没有帮助，请说出来，我会看看你的代码:)
是的，我也会在同一条船上尝试这样做。我也考虑过扁平化文件并使用 php，但我可能只是回到这里询问更多关于此的问题！ :S
将 item = matches 更改为 item = matches.Value 以完全限定它。另外，尽量不要将On Error Resume Next 用于.Find() 方法。你应该检查if matches is nothing then item = vbNullString else item = matches.Value end if

标签： excel vbscript compare range cells

【解决方案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

我认为您可能会被这一切的语法所困扰。我在您的代码中看到的一些提示：

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

希望对你有帮助

【讨论】：

谢谢约瑟夫！我会接受这个，看看我想出了什么，然后会回复。绝对给了我一些好主意！干杯！
嘿约瑟夫，我已经做了一些改变......但我仍然在努力......看看我上面的改变，如果你有任何建议，请告诉我（或其他任何人） )
所以我似乎无法让 checkformatch 函数将其字符串结果传递回主子例程，以便 exporttoworksheet 子例程使用？？？快把我逼疯了......其他一切都在工作......检查程序工作得很好......枚举提示太棒了！我喜欢它......任何帮助都会很棒。无论如何，新代码都粘贴在我的原始代码下方
啊……那个也修好了……抱歉@joseph4tw 现在只需要弄清楚为什么这两个数据集不匹配……
@BenShellrude 慢慢来。你会明白的。

【解决方案2】：

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

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

【讨论】：