Скопируйте / вставьте значения из листа в лист, если заголовки столбцов НЕ совпадают (но с использованием сопоставления заголовков на отдельном листе)

Question

Это мой первый пост ..

Я пытаюсь создать макрос для следующих действий:

1. Ввод содержит таблицу сопоставления для сопоставления различных заголовков, например:

   Mapping Sheet
    +------+------------+------+
   |header 1  |    header 2    |
    +------+------------+------+
   |sam_name  |    sam.value   |
   |John_name |    John.value  | 
   |Car_name  |  Car.value     |
    +------+------------+------+
   

2. У меня есть еще два листа: исходный и целевой лист Исходный лист имеет значения header2 в качестве заголовков в столбце 2 (например: sam.value, John.value и т. Д., И т. Д.)и заголовки целевого листа имеют значения header1 в качестве заголовков в Column1 (например, sam_name, John_name и т. д.)

3. Мне нужно скопировать и вставить значения из заголовков исходного листа на лист целевого листа в Column2 путем сопоставленияправильные соответствующие заголовки из таблицы соответствия.

Пожалуйста, помогите мне с этим.

Пожалуйста, найдите ниже коды, над которыми я работал

    Set sc = ThisWorkbook.Sheets("conf_sheet") 'Contains Mapping of headers       of source and Target sheet
    Set ws1 = ThisWorkbook.Sheets("Source_sheet")
    Set scrsh = ThisWorkbook.Worksheets("Target_sheet")

    wrow = ws1.UsedRange.Rows.Count
    wcol = ws1.UsedRange.Columns.Count
    srow = sc.UsedRange.Rows.Count
    scol = sc.UsedRange.Columns.Count

   counter = 0
   cnt = 0

     For i = 2 To srow
     For j = 1 To wcol
        If InStr(1, UCase(ws1.Cells(sc.Cells(i, 4).Value, j).Value),    UCase(sc.Cells(i, 1).Value), vbTextCompare) > 0 Then
     Range(scrsh.Cells(2, counter + 1), scrsh.Cells(wrow, counter + 1)).Value = Range(ws1.Cells(3, j), ws1.Cells(wrow, j)).Value
             counter = counter + 1

            End If
            End If
      cnt = cnt + 1
        Next j
     Next i

Я испортил вышеуказанные коды, пожалуйста, помогите мне с этим

Answer 1

Пожалуйста, убедитесь, что я правильно понимаю.

• У вас есть один целевой лист (Target) и один исходный лист (Source).

• Вы сфокусированы на метке в cells(i,1) на листе назначения.

• Вы хотите сопоставить весь исходный лист cells(j,1) с листом назначения cells(i,1)

• Если у вас есть совпадение, то вы добавляетеИсходные данные в cells(j,2) до последнего столбца листа назначения в rows(i)

---

Исходя из этого понимания, я внесу пару изменений / предложений в ваш код:

• Измените ссылки на названия листов, чтобы они отражали происходящее (например, "s" в srow и т. Д., Я думаю, что это исходный лист)

• UsedRange может быть ненадежным, поэтому обратите внимание на поиск последней строки / последнего столбца на основе некоторых строк / столбцов, в которых всегда будут данные

• Сделайте отступ в своем коде, чтобы он был более читабельным

---

Вот мой пример с копированием некоторого кода в отражении вышеприведенного понимания"):

Option Explicit

Sub test()
    Dim Conf As Worksheet, srcWS As Worksheet, dstWS As Worksheet
    Dim srcRowCt As Long, srcColCt As Long, dstRowCt As Long, dstColCt As Long
    Dim dstLastCol As Long, ValCheck As String
    Set Conf = ThisWorkbook.Sheets("conf_sheet") 'Contains Mapping of headers of source and Target sheet
    Set srcWS = ThisWorkbook.Sheets("Source_sheet")
    Set dstWS = ThisWorkbook.Worksheets("Target_sheet")
    srcRowCt = srcWS.UsedRange.Rows.Count
    srcColCt = srcWS.UsedRange.Columns.Count
    ConfRowCt = Conf.UsedRange.Rows.Count
    ConfColCt = Conf.UsedRange.Columns.Count
    'removed "counter": you're pasting one beyond the last column, so can just find that
    'removed "cnt": this didn't appear to be used at all
    With srcWS
        For i = 2 To ConfRowCt
            ValCheck = UCase(dstWS.Cells(i, 1).Value) 'Makes this check one time outside the other loop so you speed things up
            For j = 1 To srcColCt
                If InStr(1, UCase(.Cells(Conf.Cells(i, 4).Value, j).Value), ValCheck, vbTextCompare) Then
                    dstLastCol = dstWS.Cells(j, dstWS.Columns.Count).End(xlToLeft).Column   'determins last column dynamically; could also just move the "counter" you previously had up here, so you don't need +1 in your other formula
                    dstWS.Cells(1, dstLastCol + 1).Value = ValCheck 'Added in a header to column so the dstLastCol will have somethign to work with AND so you remember what was checked
                    dstWS.Range(dstWS.Cells(2, dstLastCol + 1), dstWS.Cells(wrow, dstLastCol + 1)).Value = .Range(.Cells(2, j), .Cells(srcRowCt, j)).Value 'changed source range to equal the dest range (2:srcRowCt), you had (3:srcRowCt) for source
                End If
            Next j
        Next i
    End With
End Sub

Одна вещь, которую трудно было набрать из-за других комментариев: whЕсли вы квалифицируете диапазон, квалифицируете все аспекты.У вас было Range(ws.Cells(...)), но всегда должно быть ws.Range(ws.Cells(...)) для полной квалификации.Если вы не соответствуете требованиям, то там, где появляется Range, будет активная таблица, что может привести к ошибкам.