VBA：从一个大表中调用多行

如果表中A列中的值与用户在结果表中指定的值匹配，我想从Excel表中插入行到“结果”表中。

首先我想问一下，是否有一个更有效的方式来做到这一点，而不是我已经开始的，如果没有，我会感谢一些帮助我的尝试。

我正在计划如下

1. 按列A对数据表进行sorting，以便如果添加了新项目，则按字母顺序显示
2. 使用WorksheetFunction.CountIf来确定匹配条件的行数并将其设置为variables
3. 使用WorksheetFunction.Match查找第一个匹配的行并将此值设置为variables

4. 使用已build立的variables将相关值复制到结果选项卡

   Sub CheckPrevious() Dim RowCount As Integer Dim FirstRow As Integer Dim Rng As Range Dim MatchRng As Range Dim MatchItem As Variant Rng = Sheets("Database").Range("A1:P200") MatchRng = Sheets("Database").Range("A1:A200") MatchItem = Sheets("Menu").Range("C9") RowCount = WorksheetFunction.CountIf(Worksheets("Database").Range("A:A"), _ Worksheets("Menu").Range("C9").Value) FirstRow = WorksheetFunction.Match(MatchRng, MatchItem, 0) Sheets("Pricing").Range("A2:E6").ClearContents Worksheets("Database").AutoFilter.Sort.SortFields.Clear Worksheets("Database").AutoFilter.Sort.SortFields.Add Key:= _ Range("A1:A7"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("Database").AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With If RowCount > 1 Then Sheets("Pricing").Range("A2").Value = Worksheets("Database").Range("A" & FirstRow).Value Sheets("Pricing").Range("B2").Value = Worksheets("Database").Range("B" & FirstRow).Value Sheets("Pricing").Range("C2").Value = Worksheets("Database").Range("C" & FirstRow).Value Sheets("Pricing").Range("D2").Value = Worksheets("Database").Range("D" & FirstRow).Value Sheets("Pricing").Range("E2").Value = Worksheets("Database").Range("E" & FirstRow).Value FirstRow = FirstRow + 1 End If If RowCount > 2 Then Sheets("Pricing").Range("A3").Value = Worksheets("Database").Range("A" & FirstRow).Value Sheets("Pricing").Range("B3").Value = Worksheets("Database").Range("B" & FirstRow).Value Sheets("Pricing").Range("C3").Value = Worksheets("Database").Range("C" & FirstRow).Value Sheets("Pricing").Range("D3").Value = Worksheets("Database").Range("D" & FirstRow).Value Sheets("Pricing").Range("E3").Value = Worksheets("Database").Range("E" & FirstRow).Value FirstRow = FirstRow + 1 End If If RowCount > 3 Then Sheets("Pricing").Range("A4").Value = Worksheets("Database").Range("A" & FirstRow).Value Sheets("Pricing").Range("B4").Value = Worksheets("Database").Range("B" & FirstRow).Value Sheets("Pricing").Range("C4").Value = Worksheets("Database").Range("C" & FirstRow).Value Sheets("Pricing").Range("D4").Value = Worksheets("Database").Range("D" & FirstRow).Value Sheets("Pricing").Range("E4").Value = Worksheets("Database").Range("E" & FirstRow).Value FirstRow = FirstRow + 1 End If If RowCount > 4 Then Sheets("Pricing").Range("A5").Value = Worksheets("Database").Range("A" & FirstRow).Value Sheets("Pricing").Range("B5").Value = Worksheets("Database").Range("B" & FirstRow).Value Sheets("Pricing").Range("C5").Value = Worksheets("Database").Range("C" & FirstRow).Value Sheets("Pricing").Range("D5").Value = Worksheets("Database").Range("D" & FirstRow).Value Sheets("Pricing").Range("E5").Value = Worksheets("Database").Range("E" & FirstRow).Value FirstRow = FirstRow + 1 End If End Sub 

我目前正在我的WorksheetFunction.Matchtypes不匹配错误

提前感谢任何帮助！

Answer 1

看起来你已经把MATCH的论点混淆了，第一个参数应该是你正在寻找的值，而第二个参数应该是你search的范围。 你有他们相反的方式。

为了响应您的请求，我已经编辑了一些代码，使其更加紧凑：

 Sub CheckPrevious() Dim RowCount As Long Dim FirstRow As Long Dim RowOffset As Long Dim ColumnOffset As Long Dim Rng As Range Dim MatchRng As Range Dim MatchItem As String Set Rng = ThisWorkbook.Worksheets("Database").Range("A1:P200") Set MatchRng = ThisWorkbook.Worksheets("Database").Range("A1:A200") MatchItem = ThisWorkbook.Worksheets("Menu").Range("C9") RowCount = Application.WorksheetFunction.CountIf(Worksheets("Database").Range("A:A"), MatchItem) FirstRow = Application.WorksheetFunction.Match(MatchItem, MatchRng, 0) ThisWorkbook.Worksheets("Pricing").Range("A2:E6").ClearContents With ThisWorkbook.Worksheets("Database").AutoFilter.Sort .SortFields.Clear .SortFields.Add Key:=Range("A1:A11"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With For RowOffset = 0 To RowCount - 1 For ColumnOffset = 0 To 4 ThisWorkbook.Worksheets("Pricing").Range("A2").Offset(RowOffset, ColumnOffset).Value2 _ = ThisWorkbook.Worksheets("Database").Range("A" & FirstRow).Offset(RowOffset, ColumnOffset).Value2 Next ColumnOffset Next RowOffset End Sub 

我现在不会详细讨论它的工作原理，但是我会说，你写的主要改进是外部的for循环，它完全消除了你在代码中的if语句。

我对内部for循环是否是必要的有点不确定，因为它降低了可读性，但是决定放置它，如果没有其他的理由，而不是进一步说明如何使用OFFSET来引用单元格。

你还应该注意到，如果菜单表中的C9是空白的，那么你的代码很可能会崩溃 – 所以可能会添加一个检查。

总之，我不会说这就是我如何解决你的任务，如果我是一个创build解决scheme的人，但是希望我的代码编辑能够让你对某种不同的方法有所了解解决问题。

这是我试图运行代码后，我复制到我的工作簿中的三张表：