Vbscript 查找单个列并将其从一个excel复制到另一个excel

我有一个脚本，它将a列和B列的值复制到另一个Excel的a列和B列。列标题是相同的。 我想要的是从第二个Excel中A列的第一个Excel值中查找，如果存在匹配项，则获取相应的值 同一行中B列的值，并将其粘贴到第一个Excel中。如果不匹配，则在第一个Excel的B列中插入#N/A。 第二个Excel（我们在其中查找值）应该没有更改。第一个Excel中的列B为空

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Open("C:\TEST.xlsx")
Set objWorkbook2 = objExcel.Workbooks.Open("C:\Desktop\IPT\Test.xlsx")
'objExcel.DisplayAlerts = False
Set objWorksheet = objWorkbook.Worksheets(1)
objWorksheet.Activate

Set objRange = objWorkSheet.Range("A:B").EntireColumn
objWorkSheet.Range("A:B").EntireColumn.Copy

Set objWorksheet2 = objWorkbook2.Worksheets(1)
objWorksheet.Activate

Set objRange = objWorkSheet2.Range("A:B")
objWorkSheet2.Paste objWorkSheet2.Range("A:B")
objWorksheet2.Paste(objRange)

objworkbook2.Save

objWorkbook.close("C:\TEST.xlsx")
objWorkbook2.close("C:\Desktop\IPT\Test.xlsx")

objExcel.Quit 
objExcel.DisplayAlerts = True

这是第一个Excel

A   B   C
101     12
102     13
103     15

第二个Excel文件

A   B   C
101 Toy1    small
102 Toy2    medium
103 Toy3    high

更新代码：

ProcessFiles()
Sub ProcessFiles()

    Const xlUp = -4162
    Const vbCritical = 16

    Const BOOK1 = "C:\TEST.xlsx.xls"
    Const BOOK2 = "C:\Desktop\IPT\Test.xlsx"

    Dim xlApp, xlWB, dict, r
    Set dict = CreateObject("Scripting.Dictionary")
    Set xlApp = CreateObject("Excel.Application")

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objFSO.FolderExists(BOOK1) Then
        MsgBox BOOK1 & " not found", vbCritical
        Exit Sub
    ElseIf objFSO.FolderExists(BOOK2) Then
        MsgBox BOOK2 & " not found", vbCritical
        Exit Sub
    End If
    Set objFSO = Nothing

    Set xlWB = xlApp.Workbooks.Open(BOOK2)
    With xlWB.Worksheets(1)

        For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))

            If Not dict.Exists(r.Text) Then dict.Add r.Text, r.Offset(0, 1).Value

        Next

    End With
    xlWB.Close False

    Set xlWB = xlApp.Workbooks.Open(BOOK1)
    With xlWB.Worksheets(1)

        For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))

            'r.Offset(0, 4) = IIf(dict.Exists(r.Text), dict(r.Text), "#N/A")
            If dict.Exists(r.Text) Then
                r.Offset(0, 4) = dict(r.Text)
             Else
                r.Offset(0, 4) = "#N/A"
      End If

        Next

    End With
    xlWB.Close True

End Sub

---

我可以想出两种方法

创建一个系统来将数据组织成数组，然后使用几个简单的算法将数据滑动到位。这将需要逐个单元进行解析以检索数据

我更喜欢这种方法，因为它本身作为一个程序可能非常抽象。我还强烈建议，如果你这样做的话，使用

将VLookup（）函数插入Book1:Column B单元格

我相信这会更乏味……

脚本字典使比较列表更容易。

---

@马修。也许我在理论上理解，但很抱歉，我没有遵循如何将其放入代码中，部分原因是我对VB脚本的知识非常有限。你可以编辑一下吗。我在运行脚本时遇到了以下错误：1）名称重新定义：“vbCritical”2）类型不匹配：“Dir”3）类型不匹配：“IIF”当我在google上做了一些研究时，我觉得这些语法看起来不错，但不知道为什么会抛出错误。关于Dir错误，我发现“Dir”函数不能在VBScript中使用，谢谢您的帮助。您的代码在Iff上抛出了一个错误（vb脚本无法识别Iff），所以我在该行下面用类似的代码对其进行了更新。你可以在我的帖子的更新代码下看到它。当我得到您的答案时，我能够修改您以前的代码并消除错误。但是，我现在收到以下错误：“呼叫被被叫方拒绝”。你能帮忙吗？

Sub ProcessFiles()

    Const xlUp = -4162
    Const vbCritical = 16

    Const BOOK1 = "\\norfile5\Public\Table Games\Spotlights\Back Up\SO\Book1.xlsx"
    Const BOOK2 = "\\norfile5\Public\Table Games\Spotlights\Back Up\SO\Book2.xlsx"

    Dim xlApp, xlWB, dict, r
    Set dict = CreateObject("Scripting.Dictionary")
    Set xlApp = CreateObject("Excel.Application")

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objFSO.FolderExists(BOOK1) Then
        MsgBox BOOK1 & " not found", vbCritical
        Exit Sub
    ElseIf objFSO.FolderExists(BOOK2) Then
        MsgBox BOOK2 & " not found", vbCritical
        Exit Sub
    End If
    Set objFSO = Nothing

    Set xlWB = xlApp.Workbooks.Open(BOOK2)
    With xlWB.Worksheets(1)

        For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))

            If Not dict.Exists(r.Text) Then dict.Add r.Text, r.Offset(0, 1).Value

        Next

    End With

    xlWB.Close False

    Set xlWB = xlApp.Workbooks.Open(BOOK1)
    With xlWB.Worksheets(1)

        For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))

        If dict.Exists(r.Text) then 
            r.Offset(0, 1) =  dict(r.Text)
        Else
            r.Offset(0, 1) =  "#N/A"
        End If

        Next

    End With

    xlWB.Save 

    xlWB.Close False

    xlApp.Quit

    Msgbox BOOK1 & " has been updated"
End Sub