在excel里处理数据的VBA代码

心一

计算机技术与软件专业技术资格证持证人

有时候在处理excel的数据时，其实有很多自己的想法在excel上无法得到实现，这就需要用到VBA编程了，从而实现按自己需求进行定制化开发。

VBA（Visual Basic for Applications）是一种编程语言，它是基于 Microsoft Visual Basic 开发的，可以在 Microsoft Office 套件中的许多应用程序中使用，包括

Microsoft Excel
Microsoft Word
Microsoft PowerPoint
Microsoft Access
Microsoft Outlook
Microsoft Project
Microsoft Visio

使用 VBA，可以执行以下操作：

编写自定义宏：VBA 可以在 Microsoft Office 应用程序中创建自定义宏，以自动执行一系列任务。
自动化重复性任务：使用 VBA，可以编写脚本来自动执行繁琐的、重复性的任务，从而提高工作效率。
增强功能：VBA 可以扩展 Microsoft Office 应用程序的功能，使其能够执行更多操作。
自定义用户界面：使用 VBA，可以创建自定义对话框和用户界面，以便更好地与用户交互。

VBA 是一种功能强大的编程语言，但需要一定的编程经验和技能才能充分利用其功能。

我遇到的问题是需要对原word内的数据进行清洗，然后遍历所有数据从而实现提取所需要数据的功能。

这里举例一个表格，如下图所示:

需要提取这个表格内的需要单元格，例如：”抗震设防类别”, “结构体系”, “建筑功能”等。

当在Excel中写VBA代码时，可以通过以下步骤在一个区域内查找多个单元格，并将匹配的单元格及其之后的数据输出到电脑桌面的Excel文件中：

打开Excel文件并按下”Alt + F11″，进入Visual Basic for Applications (VBA)编辑器。
在VBA编辑器中，点击”插入”，然后选择”模块”，在新的模块中编写以下VBA代码：

Sub 导出匹配单元格及数据到Excel()
Dim sourceRange As Range
Dim searchValues() As Variant
Dim foundRows As Collection
Dim i As Long, j As Long
Dim desktopPath As String
' 填入要查找的单元格的区域
Set sourceRange = Range("A2:D9")
' 填入要查找的单元格值，可以添加更多值
searchValues = Array("抗震设防类别", "结构体系", "建筑功能")
' 初始化集合以保存查找到的行
Set foundRows = New Collection
' 遍历源区域查找匹配的单元格
For i = 1 To sourceRange.Rows.Count
For j = 1 To sourceRange.Columns.Count
If IsInArray(sourceRange.Cells(i, j).Value, searchValues) Then
' 将匹配的单元格及其之后的数据添加到集合中
foundRows.Add sourceRange.Cells(i, j).Resize(1, sourceRange.Columns.Count - j + 1)
Exit For ' 停止查找当前行
End If
Next j
Next i
' 初始化新的Excel工作簿
Dim excelApp As Object
Dim excelWorkbook As Object
Dim excelWorksheet As Object
Set excelApp = CreateObject("Excel.Application")
excelApp.Visible = False ' 设置为True可见，设置为False不可见
Set excelWorkbook = excelApp.Workbooks.Add
Set excelWorksheet = excelWorkbook.Sheets(1)
' 输出匹配的单元格及其之后的数据到新的Excel工作簿
Dim rowIndex As Long, colIndex As Long
rowIndex = 1
For Each Rng In foundRows
colIndex = 1
For Each cell In Rng.Cells
excelWorksheet.Cells(rowIndex, colIndex).Value = cell.Value
colIndex = colIndex + 1
Next cell
rowIndex = rowIndex + 1
Next Rng
' 获取电脑桌面路径
desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
' 保存Excel文件到桌面
excelWorkbook.SaveAs desktopPath & "\匹配单元格及数据.xlsx"
' 释放Excel对象
excelWorkbook.Close SaveChanges:=False
Set excelWorkbook = Nothing
excelApp.Quit
Set excelApp = Nothing
MsgBox "匹配单元格及数据已导出到桌面的Excel文件!"
End Sub
Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean
Dim element As Variant
On Error Resume Next
IsInArray = (UBound(Filter(arr, valToBeFound)) > -1)
On Error GoTo 0
End Function