Замена данных Excel с помощью другой таблицы

Question

У меня есть две таблицы Excel, одна из которых содержит данные о разных людях, а другая - скорее индекс.

Электронная таблица «Индекс» представлена ​​следующим образом (в качестве примера);

      A       B
1 [person:][pID: ]
2 [Mark   ][1    ]
3 [James  ][2    ]
4 [John   ][3    ]
5 [David  ][4    ]
n [ ...   ][n    ]

Электронная таблица «Данные» выглядит следующим образом (в качестве примера):

      A
1 [pID:   ][ ...
2 [David  ][ ...
3 [David  ][ ...
4 [David  ][ ...
5 [James  ][ ...
6 [Mark   ][ ...
7 [David  ][ ...
n [ ...   ][ ...

Я хотел бы заменить столбец А в электронной таблице «Данные» насоответствующий индекс электронной таблицы 'Index', вероятно, с использованием VBA.

Результат будет примерно таким;

      A
1 [pID:   ][ ...
2 [4      ][ ...
3 [4      ][ ...
4 [4      ][ ...
5 [2      ][ ...
6 [1      ][ ...
7 [4      ][ ...
n [ ...   ][ ...

Я видел некоторые статические подходы, которые используют оператор switch, ноЯ действительно хотел бы иметь возможность импортировать данные из другой таблицы.Я пытаюсь не прибегать к копированию и вставке «Заменить все».

Спасибо!

Answer 1

Попробуйте это:

Sub HTH()

    With Sheets("Data")
        .Columns(2).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Cells(1, "B").Value = .Cells(1, "A").Value
        With .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Offset(, 1)
            .Formula = "=VLOOKUP(A2,Index!A:B,2,FALSE)"
            .Value = .Value
        End With
        .Columns(1).Delete
    End With

End Sub

Объяснение:

Sub HTH()

    With Sheets("Data")
        '// Insert a new column with same format
        .Columns(2).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        '// Copy the header
        .Cells(1, "B").Value = .Cells(1, "A").Value
        '//  Work with the used range of column A 
        With .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Offset(, 1)
            '// Use a formula to replace the names with corresponding values
            .Formula = "=VLOOKUP(A2,Index!A:B,2,FALSE)"
            '// Replace formula with value
            .Value = .Value
        End With
        '//  Delete the old column
        .Columns(1).Delete
    End With

End Sub

ПРИМЕЧАНИЕ:

Лично я бы оставил лист с необработанными данными каки используйте презентационный лист, который просматривает лист данных и индексный лист и представляет его так, как вы хотите.Тогда вам не обязательно нужен код, и если вы все еще хотите использовать код, тогда код будет намного проще.Вам нужно будет добавить код, чтобы отключить обновление экрана и использовать обработку ошибок и т. Д.

Альтернатива решению ja72:

Sub HTH()
    Dim vNames As Variant, vResult As Variant
    Dim lLoop As Long

    vNames = Sheets("Index").UsedRange.Columns(1).Resize(, 2).Value2
    vResult = Sheets("Data").UsedRange.Columns(1).Value2

    With CreateObject("Scripting.Dictionary")
        For lLoop = 2 To UBound(vNames, 1)
            .Add vNames(lLoop, 1), vNames(lLoop, 2)
        Next lLoop

        For lLoop = 2 To UBound(vResult, 1)
            vResult(lLoop, 1) = .Item(vResult(lLoop, 1))
        Next lLoop

        Sheets("Data").Range("A1").Resize(UBound(vResult, 1), 1).Value = vResult
    End With

End Sub

тихо уверена, что он тоже быстрее;)

Answer 2

Я не верю, что VBA - лучшее решение этой проблемы.Простой VLOOKUP будет выполнять именно то, что вам нужно.

=VLOOKUP(Data!$A1, Index!$A$2:$A$5, 1, FALSE)

даст вам результаты, которые вы ищете.

Answer 3

Попробуйте это с VBA:

Public Sub FindPID()
    Dim i As Integer, N As Integer
    Dim r_index As Range
    ' Find start of index
    Set r_index = Sheets("Index").Range("A2")
    ' Count rows in index
    N = r_index.Worksheet.Range(r_index, r_index.End(xlDown)).Rows.Count
    ' Expand range with all values
    Set r_index = r_index.Resize(N, 2)
    Dim vals As Variant
    ' Move values into array
    vals = r_index.Value2
    ' Create a lookup collection
    Dim lup As New Collection
    For i = 1 To N
        ' Add each pID to collection with name as key
        lup.Add vals(i, 2), vals(i, 1)
    Next i

    Dim r_data As Range, M As Integer
    ' Find start of data
    Set r_data = Sheets("Data").Range("A2")
    ' Count rows in data
    M = r_data.Worksheet.Range(r_data, r_data.End(xlDown)).Rows.Count
    ' Expand range with all values
    Set r_data = r_data.Resize(M, 1)
    ' Move values into array
    vals = r_data.Value2
    For i = 1 To M
        ' Replace first column with lookup pID
        vals(i, 1) = lup(vals(i, 1))
    Next i
    ' Assign values from array back to cells.
    r_data.Value2 = vals
End Sub

Это будет работать быстрее всего.