Question

我有2个工作簿：“MainWorkbook.xlsm”和“ReferenceWorkbook.xlsx”。参考工作簿是主工作簿从中提取数据的报告。

我的主工作簿中有一个名为“Vendor Name”的列，它是第J列。参考工作簿中“供应商名称”将引用的列是X列，名为“Vendor_Data”。 2个工作表中的两个供应商列都是非数字数据类型。此外，这两个工作表都受行数的影响;我可能有一天在“Mainworkbook.xlsm”中有200行，下一行有230行。这同样适用于“ReferenceWorkbook”。 “MainWorkbook.xlsm”中的供应商列将保持静态，只要它的索引值为，但ReferenceWorkbook.xlsx中供应商列的位置可能在将来发生变化（例如，从列x到列y）。 “MainWorkbook”中的标题行是第2行，而“ReferenceWorkbook”中的标题行是第1行。

我想要做的是构建一个宏，它将自动填充“MainWorkbook”中的供应商列，首先根据它们的标题匹配“ReferenceWorkbook”中的供应商列，然后按主键匹配行（C列）在“MainWorkbook”中和“ReferenceWorkbook”中的K列）。 “ReferenceWorkbook”中的主键列也可能会更改它的列索引，就像它的供应商列一样，所以我想根据标题名称而不是它们的索引值来进行所有标题匹配。

由于我刚刚开始使用VBA，我到目前为止所做的最好的是一个不完整且非常逻辑上有缺陷的代码块：

Sub New_Macro（）

Dim ran As Range, source_header As Range, target_header As Range
Dim source As Workbook, source_sheet As Worksheet, target As Workbook, target_sheet As Worksheet
Dim i As Integer, j As Integer, Match_header As Integer

Set source = Application.Workbooks("ReferenceWorkbook.xlsx")
Set Reference_sheet = source.Worksheets("ReferenceSheet")
Set target = Application.Workbooks("MainWorkbook.xlsm")
Set target_sheet = target.Worksheets("MainSheet")
Set source_worksheet_header = source_sheet.Range("X1")
Set target_worksheet_header = target_sheet.Range("J2")

LR = target_sheet.Cells(Rows.Count, 1).End(xlUp).Row
j = 10
Set ran = target_sheet.Range("J3" & LR)

ran.ClearContents

Do While j < 11

    For Each cell In target_worksheet_header
        For i = 3 To LR
            Match_header = source_worksheet_header.Find(cell.Value)
                    target_sheet.Cells(i, j).Value = Application.WorksheetFunction.Index(source_sheet.Range("X"), WorksheetFunction.Match(target_sheet.Cells(i, 10).Value, source_sheet.Range("X"), LR), Match_header)
                    On Error Resume Next
        Next i
        j = j + 1
    Next cell

Loop

End Sub

有没有人有办法将其变成实际的解决方案？任何帮助都会很奇妙

Answer 1

已编译但未经过测试：

Sub New_Macro()

    Dim ran As Range, c As Range
    Dim source_sheet As Worksheet
    Dim target_sheet As Worksheet
    Dim srcVendorCol As Range, srcIdCol As Range, f As Range
    Dim vndr, r, id
    Dim LR As Long

    Set source_sheet = Workbooks("ReferenceWorkbook.xlsx") _
                           .Worksheets("ReferenceSheet")
    Set target_sheet = Workbooks("MainWorkbook.xlsm") _
                           .Worksheets("MainSheet")

    Set f = source_sheet.Rows(1).Find(what:="Vendor_Data", _
                           lookat:=xlWhole, LookIn:=xlValues)
    If Not f Is Nothing Then
        Set srcVendorCol = f.EntireColumn
    End If

    Set f = Nothing
    Set f = source_sheet.Rows(1).Find(what:="PrimaryKey", _
                           lookat:=xlWhole, LookIn:=xlValues)
    If Not f Is Nothing Then
        Set srcIdCol = f.EntireColumn
    End If

    If srcVendorCol Is Nothing Or srcIdCol Is Nothing Then
        MsgBox "Required column headers not found in source sheet!"
        Exit Sub
    End If

    'find last populated cell in Col J
    LR = target_sheet.Cells(Rows.Count, "J").End(xlUp).Row 'EDIT
    Set ran = target_sheet.Range("J3:J" & LR)

    For Each c In ran.Cells

        id = c.EntireRow.Cells(3).Value

        If Len(id) > 0 Then 'EDIT - added check for Id length 

            r = Application.Match(id, srcIdCol, 0)

            If Not IsError(r) Then
                c.Value = Application.Index(srcVendorCol, r, 1)
            Else
                c.Value = "Id not found"
            End If

        End If

    Next c

End Sub

使用MATCH功能自动填充色谱柱

1 个答案: