Question

我是vba编程的新手或中级学习者，并想出了一个任务，通过匹配多个条件将sheet1的workbook1中的单元格值复制到sheet1的workbook2，并将Sort reference（workbook1）列单元格值复制到Notes和Assumption（workbook2）单元格。

Workbook1 Column Workbook2 Column 功能组与-------＆gt;匹配初级技能

LOB与-------＆gt;匹配服务热线

地区/国家/地区匹配-------＆gt;需要工作的国家

排序参考（工作簿1）-------------------＆gt;注释和假设（工作簿2）（注意： - 匹配条件并将相应的行排序参考值复制到列注释和假设）

目标工作簿2要匹配的列 Criteria to match from workbook2

源Workbook1列是 Criteria to match from workbook1

输出演示 Output of workbook2 in Notes And Assumptions Column 注意： - 输出应如图像中所示，如果未找到数据，请留空

我在下面尝试了但没有得到结果，因为如果条件匹配并且值粘贴在特定列中，则匹配的行不应再次重复，而是从下一行开始匹配。因此，我的价值得到了覆盖。

   Sub sortref()

Dim wbk, wbk1 As Workbook
Dim sht, sht1 As Worksheet
Dim i, j, k, n, m As Long
Dim FGroup, PSkills, RegCoun, WrCoun, MRCode, RCode As String

Application.DisplayAlerts = False

Set wbk = Workbooks.Open(Filename:="C:\Users\611892636\desktop\RMT Changes\RMT v8.0.2 - Huawei V1.2.xlsm")
Workbooks("RMT v8.0.2 - Huawei V1.2.xlsm").Activate
Workbooks("RMT v8.0.2 - Huawei V1.2.xlsm").Sheets("Input").Activate

Set sht = Workbooks("RMT v8.0.2 - Huawei V1.2.xlsm").Worksheets("Input")
Set sht1 = Workbooks("RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb").Worksheets("MUForecasts")

Workbooks("RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb").Activate
Workbooks("RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb").Sheets("MUForecasts").Activate

n = sht1.Range("B" & Rows.Count).End(xlUp).Row
m = sht.Range("B" & Rows.Count).End(xlUp).Row

    For i = 13 To m
        For k = 3 To n
            Debug.Print i, k

            FGroup = sht.Range("H" & i)
            PSkills = sht1.Range("R" & k)

            RegCoun = sht.Range("L" & i)
            WrCoun = sht1.Range("P" & k)

            MRCode = sht.Range("X" & i)
            RCode = sht1.Range("Q" & k)

            If FGroup = PSkills Then
               If RegCoun = WrCoun Then
                    If MRCode = RCode Then
                        sht.Cells(i, 2).Copy
                        sht1.Cells(k, 27).Select
                        Selection.PasteSpecial Paste:=xlPasteValues
                    End If
                End If
            End If
         Next k
    Next i

'wbk.Close
Set wbk = Nothing
Set sht = Nothing
Set sht1 = Nothing
Application.DisplayAlerts = True

End Sub

Answer 1

您可以尝试使用高级过滤器方法并将其绑定到您的代码中。

    Sheets("Emps").Range("A1:D8").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Emps").Range("F5:F6"), CopyToRange:=Range("A1:B1"), _
    Unique:=False

有选择地复制的数据：

复制的数据：

参考此简短的YouTube视频;您也可以记录一个marco来帮助自己代码：
https://www.youtube.com/watch?v=bGUKjXmEi2E

这里有一个更强大的详尽的教程：
http://www.contextures.com/xladvfilter01.html

本教程介绍如何从Excel外部获取源数据：
https://www.extendoffice.com/documents/excel/4189-excel-dynamic-filter-to-new-sheet.html

本教程介绍如何将基于列的数据值拆分为不同的工作表（Fruit列; Apple工作表，Pear工作表等）：
https://www.extendoffice.com/documents/excel/2884-excel-save-filtered-data-new-sheet-workbook.html

从两个工作表中复制匹配多个条件的单元格值

1 个答案: