/** *拆分表格 Macro */ function 拆分表格() 用以上vba代码将拆分工作表并命名为指定的内容

这是一个Excel VBA代码，用于将一个表格按照某个关键字拆分成多个子表格，并将子表格命名为指定的内容。具体实现如下： ``` Sub SplitTable() Dim ws As Worksheet Set ws = ActiveSheet Dim dataRange As Range Set dataRange = ws.UsedRange Dim headers As Variant headers = Application.Transpose(dataRange.Rows(1).Value) Dim keywordColumn As Long keywordColumn = Application.Match("关键字", headers, False) Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") ' 遍历数据行，根据关键字创建子表格 Dim i As Long For i = 2 To dataRange.Rows.Count Dim rowValues As Variant rowValues = Application.Transpose(dataRange.Rows(i).Value) Dim keyword As String keyword = rowValues(keywordColumn) If Not dict.Exists(keyword) Then Dim newWs As Worksheet Set newWs = ThisWorkbook.Sheets.Add(After:=ws) newWs.Name = keyword headers(keywordColumn) = "" newWs.Range("A1").Resize(1, UBound(headers)).Value = headers dict.Add keyword, newWs End If Dim newRowValues As Variant newRowValues = Application.Index(rowValues, 0, Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)) newRowValues(keywordColumn) = "" dict(keyword).Cells(dict(keyword).Rows.Count, "A").End(xlUp).Offset(1).Resize(1, UBound(newRowValues)).Value = newRowValues Next i End Sub ``` 该函数首先获取当前活动的工作表，并使用UsedRange属性获取整个表格的数据范围。然后，它遍历数据行，根据指定的关键字创建新的子表格，并将符合条件的行复制到相应的子表格中。 具体地，该