VBA快速提取Excel数据的实用技巧

创作时间:

作者:

@小白创作中心

VBA快速提取Excel数据的实用技巧

引用

CSDN

https://m.blog.csdn.net/taller_2000/article/details/145878792

在处理大量Excel数据时，如何快速准确地提取所需信息是一个常见的需求。本文将通过一个具体实例，展示如何使用VBA（Visual Basic for Applications）编写代码，实现数据的高效提取。

实例需求

假设我们有如下原始数据表：

现在需要在每个类目中，查找编号最大的分组，然后提取该分组中评分最高的数据行（假设每个类目中符合要求的数据行是唯一的）。

解决方案思路

粗略看这个需求，似乎需要使用字典对象来排重提取类目，然后再查找最大分组。但实际上，通过变通一下思路，可以有更简单的实现方法。

如果将数据按照前3列依次升序排序，那么表格会变成如下所示，需要提取的数据行进行了高亮标记：

不难发现其中的规律：其实就是每个类目的最后一行数据。

示例代码

以下是具体的VBA代码实现：

Sub Demo()
    Dim i As Long, j As Long
    Dim arrData, rngData As Range
    Dim arrRes, iR As Long
    Dim srcSht As Worksheet: Set srcSht = Sheets("Sheet1")
    Sheets.Add
    srcSht.Range("A1").CurrentRegion.Copy Range("A1")
    Set rngData = Range("A1").CurrentRegion
    With rngData
        .Sort key1:=.Cells(1, 1), order1:=xlAscending, _
            key2:=.Cells(1, 2), order2:=xlAscending, _
            key3:=.Cells(1, 3), order2:=xlAscending, _
            Header:=xlYes
    End With
    Set rngData = rngData.Resize(rngData.Rows.Count + 1)
    arrData = rngData.Value
    Dim RowCnt As Long: RowCnt = UBound(arrData)
    Dim ColCnt As Long: ColCnt = UBound(arrData, 2)
    ReDim arrRes(1 To RowCnt, 1 To ColCnt)
    For i = LBound(arrData) To UBound(arrData) - 1
        If Not arrData(i, 1) = arrData(i + 1, 1) Then
            iR = iR + 1
            For j = LBound(arrData, 2) To UBound(arrData, 2)
                arrRes(iR, j) = arrData(i, j)
            Next j
        End If
    Next i
    rngData.Clear
    Range("A1").Resize(iR, ColCnt).Value = arrRes
End Sub

代码解析

第5行代码获取数据表所在工作表对象。
第6行代码创建新的工作表。
第7行代码将数据表拷贝到新建工作表。
第8行代码获取数据表单元格区域，注意是在新建工作表中，这样可以避免排序代码改变原始表格的数据顺序。
第9~14行代码对表格进行排序。
第15行代码将表格区域扩展一行，即包含表格之下的一个空行。这样可以更简便地提取表格中的最后一个符合要求的数据行。
第16行代码将表格读取到数组中，这样可以提升后续的代码执行效率。
第17和18行代码获取表格的行数和列数。
第19行代码为结果数组分配内存空间。
第20~27行代码循环遍历数据表格。
第21行代码判断当前行的类目列单元格内容是否下一行单元格相同。
如果不同，说明当前行符合要求，第22~25行代码提取数据行。
此处使用了一个小技巧：For循环过程从第1行开始，即包含标题行，由于标题行和数据表中内容肯定不同，因此实现了提取含标题行到结果数组。这样避免了增加额外代码单独提取标题行。
第28行代码清除新建工作表中的数据表。
第29行代码将提取结果写入工作表。