Excel два столбца сравнения разных файлов и заменить следующий столбец - PullRequest
Новая
       4

Excel два столбца сравнения разных файлов и заменить следующий столбец

1 голос
/ 19 июня 2020

Привет, я хочу сравнить два файла Excel, и если какие-либо строки в пакетах file1 coumun B с File2 ColumnA, то я хочу заменить соответствующий File2 ColumB столбцом File1 C

например: if File 1, B3 совпадает с File2 A5, тогда я хочу заменить строку в B5 файла 2 на C3 файла1

Ответы [ 2 ]

0 голосов
/ 19 июня 2020

Обновление таблицы сравнения столбцов

  • Тщательно настройте const муравьев, включая Рабочие книги .
  • Скопируйте код в стандартный модуль (например, 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
0 голосов
/ 19 июня 2020

Предположим, что File1 расположение: «C: \ test \ File1.xlsx» поэтому вы можете импортировать File1: значения столбца A в File2: столбец K по формуле 

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

Теперь в File2 легко писать формулы в зависимости от импортированных значений

...