Переименовать столбцы и объединить с другим листом по имени столбца

Question

У меня есть два аналогичных набора данных / диапазонов на отдельных листах, оба начинаются в ячейке A1. Два листа называются «таблица 1» и «таблица 2».

Первая таблица на имя листа: table1 выглядит следующим образом: ТАБЛИЦА 1

Вторая таблица на имя листа: таблица 2 выглядит следующим образом: ТАБЛИЦА 2

Столбцы в таблицах представляют одни и те же вещи, однако, не имеют одинаковых названий и не расположены в одном и том же порядке.

Я пытаюсь сопоставить столбцы на основе имени ("название школы" = "адрес школы", "chalk" = "ящик для мелков", "duster" = "erasor", "board" = " blackboard "," ruler "=" meter ").

Мне нужно объединить вторую таблицу с первой таблицей, сохранив заголовки столбцов первой таблицы. Мне также нужно, чтобы он работал, если в данных есть пробелы.

Конечный продукт (на новом листе или в таблице 1) должен выглядеть так: Конечный продукт

Мне очень жаль, я новичок в VBA. Я могу использовать

Sheets("TABLE2").Range("A1:E5").Copy Destination:=Sheets("TABLE1").Range("D1")

, чтобы скопировать мою фиктивную таблицу, однако это не дает совпадения и не работает, если есть дополнительные строки.

Многие спасибо за любую помощь.

Answer 1

Попробуйте этот код, пожалуйста. Он будет соответствовать эквивалентности заголовков (хранящихся в arrEch) и копировать каждый столбец за раз, одновременно:

Sub testMatchTables()
  Dim shT1 As Worksheet, shT2 As Worksheet, lastR1 As Long, lastR2 As Long
  Dim arrEch As Variant, arrInt As Variant, El As Variant, matchRng1 As Range, matchRng2 As Range

    Set shT1 = Worksheets("TABLE1")
    Set shT2 = Worksheets("TABLE2")
     lastR1 = shT1.Range("A" & Rows.Count).End(xlUp).row
     lastR2 = shT2.Range("A" & Rows.Count).End(xlUp).row
     arrEch = Split("school name|school address,chalk|chalk box,duster|erasor,board|blackboard,ruler|measuring stick", ",")
     'Check the headers equivalence (for spelling errors):
     If Not ChechEquivalence(arrEch, shT1, shT2) Then Exit Sub
     For Each El In arrEch
        arrInt = Split(El, "|") 'extract each header from the "|" separated array element
        Set matchRng1 = shT1.Rows(1).Find(arrInt(0))
        Set matchRng2 = shT2.Rows(1).Find(arrInt(1))
        If Not matchRng1 Is Nothing And Not matchRng2 Is Nothing Then
            shT1.Cells(lastR1 + 1, matchRng1.Column).Resize(lastR2 - 1, 1).Value = _
                    shT2.Range(matchRng2.Offset(1), shT2.Cells(lastR2, matchRng2.Column)).Value
        End If
     Next
End Sub
'The next function check the matching headers equivalence:
Private Function ChechEquivalence(arr As Variant, shT1 As Worksheet, shT2 As Worksheet) As Boolean
   Dim El As Variant, arrInt As Variant, matchRng1 As Range, matchRng2 As Range
   For Each El In arr
        arrInt = Split(El, "|")
        Set matchRng1 = shT1.Rows(1).Find(arrInt(0))
        Set matchRng2 = shT2.Rows(1).Find(arrInt(1))
        If matchRng1 Is Nothing Then
            MsgBox "Eny equivalence between """ & arrInt(0) & """ could be find in """ & shT1.Name & """ header!" & vbCrLf & _
                "Please, check the array definition of this element, correct it and try again.", vbInformation, "Wrong Header spellinig"
            ChechEquivalence = False: Exit Function
        If matchRng2 Is Nothing Then
            MsgBox "Eny equivalence between """ & arrInt(1) & """ could be find in """ & shT2.Name & """ header!" & vbCrLf & _
                "Please, check the array definition of this element, correct it and try again.", vbInformation, "Wrong Header spellinig"
            ChechEquivalence = False: Exit Function
        End If
     Next
     ChechEquivalence = True
End Function

Способ проверки эквивалентности допускает небольшие различия между определением эквивалентности заголовков массива и реальным написание заголовков. Я имею в виду, что 'rulers will be find (instead of ruler'), и код будет хорошо работать и в таких обстоятельствах ...