Excel两列不同文件比较并替换下一列

Question

嗨，我想比较两个 excel 文件，如果 file1 coumun B 中的任何字符串与 File2 ColumnA 批处理，那么我想用 File1 Column C 替换相应的 File2 的 ColumB

例如： 如果 File 1, B3 与 File2 A5 匹配，那么我想用 file1 的 C3 替换文件 2 的 B5 中的字符串

Answer 1

假设 File1 位置是“C:\test\File1.xlsx”
因此您可以通过公式将 File1:column A 值导入 File2:column K

File2:K1 formule
='C:\test\[File1.xlsx]Sheet1'!A1
File2:K2 formule
='C:\test\[File1.xlsx]Sheet1'!A2
and so on

现在很容易在 File2 中编写依赖于导入值的公式

Answer 2

列比较工作表更新

• 仔细调整constant，包括Workbooks。
• 将代码复制到标准模块中（例如Module1）。

守则

Option Explicit

Sub updateWorksheet()

    ' Source
    Const srcWb As String = "Source.xlsm"
    Const srcWs As String = "Sheet1"
    Const srcFirstRow As Long = 2
    Const srcCriteria As Variant = "B"
    Const srcValue As Variant = "C"
    ' Target
    Const tgtWb As String = "Target.xlsm"
    Const tgtWs As String = "Sheet2"
    Const tgtFirstRow As Long = 2
    Const tgtCriteria As Variant = "A"
    Const tgtValue As Variant = "B"
    ' Workbooks
    Dim wbSrc As Workbook: Set wbSrc = Workbooks(srcWb)
    'Dim wbSrc As Workbook: Set wbSrc = ThisWorkbook
    Dim wbTgt As Workbook: Set wbTgt = Workbooks(tgtWb)
    'Dim wbTgt As Workbook: Set wbTgt = ThisWorkbook

    ' Write values from Source Range to Source Array.
    Dim src As Worksheet: Set src = wbSrc.Worksheets(srcWs)
    Dim rng As Range
    Set rng = src.Columns(srcCriteria).Find("*", , xlValues, , , xlPrevious)
    If rng Is Nothing Then Exit Sub
    If rng.Row < srcFirstRow Then Exit Sub
    Set rng = src.Range(src.Cells(srcFirstRow, srcCriteria), rng)
    Dim Source(1) As Variant: Source(0) = rng.Value
    Source(1) = rng.Offset(, src.Columns(srcValue).Column - rng.Column).Value

    ' Write values from Target Range to Target Array.
    Dim tgt As Worksheet: Set tgt = wbTgt.Worksheets(tgtWs)
    Set rng = tgt.Columns(tgtCriteria).Find("*", , xlValues, , , xlPrevious)
    If rng Is Nothing Then Exit Sub
    If rng.Row < tgtFirstRow Then Exit Sub
    Set rng = tgt.Range(tgt.Cells(tgtFirstRow, tgtCriteria), rng)
    Dim Target(1) As Variant: Target(0) = rng.Value
    Set rng = rng.Offset(, tgt.Columns(tgtValue).Column - rng.Column)
    Target(1) = rng.Value
    Dim Curr As Variant

    ' Write from Source Array to Target Array.
    Dim i As Long
    For i = 1 To UBound(Target(0))
        Curr = Application.Match(Target(0)(i, 1), Source(0), 0)
        If Not IsError(Curr) Then
            Target(1)(i, 1) = Source(1)(Curr, 1)
        End If
    Next i

    ' Write from Target Array to Target Range.
    rng.Value = Target(1)

    ' Inform user.
    MsgBox "Data transferred.", vbInformation, "Success"

End Sub