Question

这是我的第一篇文章。

我正在尝试创建一个宏来执行以下操作：

输入包含映射表以匹配不同的标题例如：

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

我还有另外两个表，分别是源表和目标表源工作表的header2值作为Column2中的标题（例如：sam.value，John.value等），目标工作表的标题具有header1值作为Column1中的标题（例如：sam_name，John_name等）
我需要通过映射映射表中正确的相应标题将值从源表标题复制粘贴到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

请确认我正确理解了这一点。

您有一个目标表（目标）和一个源表（源）。
您将专注于目标工作表cells(i,1)中的标签。
您要匹配所有源工作表cells(j,1)和目标工作表cells(i,1)
如果有匹配项，则将cells(j,2)中的源数据附加到rows(i)上目标表的最后一列

基于这些理解，我将对您的代码进行一些更改/建议：

将工作表名称引用更改为代表正在发生的事情（例如，闷头中的“ s”等，使我认为这是源工作表）
UsedRange可能不可靠，因此请看一下根据某些将始终具有数据的行/列查找最后一行/最后一列
缩进代码，使其更具可读性

以下是我对模拟代码的嘲讽，以反映上述理解（由于缺乏对“ conf_sheet”的理解，因此未进行测试）：

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

一则由于其他评论而难以打字的事情：限定范围时，限定所有方面。您拥有Range(ws.Cells(...))，但应始终为ws.Range(ws.Cells(...))以完全具备资格。如果您不完全符合资格，则Range出现的任何地方都会使用该工作表，这可能会导致错误。

如果列标题不匹配，则在工作表之间复制/粘贴值（但使用单独工作表中的标题映射）

1 个答案: