Excel VBA 数据分类导入sheet
1. 程序功能
将Excel表格数据按照PC编号分类到不同Sheet。
2. 程序流程
3. 主要子程序说明
3.1 SplitDataFaster()
主程序，控制整个数据分类流程。
- 获取工作表信息
- 调用其他子程序
- 处理数据分类逻辑
3.2 DeleteExistingSheets()
删除已存在的PC工作表。
3.3 CreateNewSheets()
创建新的分类工作表。
3.4 CopyHeaders()
复制表头到新工作表。
3.5 CopyRowToSheet()
复制数据行到指定工作表。
3.6 AdjustAllSheets()
调整所有工作表的列宽。
4. VBA语法和函数说明
4.1 常用声明
Dim ws As Worksheet ' 工作表对象声明
Dim lastRow As Long ' 长整型变量
Dim sheetNames As Variant ' 变体类型数组
4.2 工作表操作
Set ws = ActiveSheet ' 获取活动工作表
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row ' 获取最后一行
Worksheets.Add ' 添加新工作表
ws.Delete ' 删除工作表
4.3 字符串处理
Left(string, length) ' 获取左侧字符
Mid(string, start, length) ' 获取中间字符
InStr(string, substring) ' 查找子字符串位置
4.4 数据复制
sourceWs.Rows(1).Copy destination ' 复制整行
4.5 应用程序控制
Application.ScreenUpdating = False ' 关闭屏幕刷新
Application.DisplayAlerts = False ' 关闭警告提示
4.6 条件判断
If condition Then ' IF语句
Select Case value ' Select Case语句
4.7 循环结构
For Each ... In ... ' 集合遍历
For i = start To end ' 数值循环
5. 使用说明
-
数据要求：
- 第二列(B列)包含PC编号
- PC编号格式：PC数字-xxx
-
运行步骤：
- 确保当前工作表为需要处理的数据表
- 运行SplitDataFaster宏
- 等待处理完成提示
-
输出结果：
- PC01_11：PC1-11的数据
- PC12_22：PC12-22的数据
- PC23_44：PC23-44的数据
- PC45_67：PC45-67的数据
- PC82：PC82的数据
- PC83_87：PC83-87的数据
- PC68_92：PC68-81和PC88-92的数据
6. 性能优化说明
- 关闭屏幕刷新提高运行速度
- 关闭警告消息避免中断
- 使用直接复制而非数组操作
- 统一处理工作表创建和删除
Sub SplitDataFaster()Dim ws As WorksheetDim lastRow As LongDim i As LongDim pcNum As Integer' 设置当前工作表Set ws = ActiveSheetlastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).RowApplication.ScreenUpdating = FalseApplication.DisplayAlerts = False' 删除现有的分组工作表DeleteExistingSheets' 创建新工作表CreateNewSheets' 复制标题行到每个新表CopyHeaders ws' 处理每一行数据For i = 2 To lastRowIf Left(ws.Cells(i, 2).Value, 2) = "PC" ThenpcNum = CInt(Mid(ws.Cells(i, 2).Value, 3, InStr(ws.Cells(i, 2).Value, "-") - 3))' 根据PC编号分组Select Case pcNumCase 1 To 11CopyRowToSheet ws, i, "PC01_11"Case 12 To 22CopyRowToSheet ws, i, "PC12_22"Case 23 To 44CopyRowToSheet ws, i, "PC23_44"Case 45 To 67CopyRowToSheet ws, i, "PC45_67"Case 82CopyRowToSheet ws, i, "PC82"Case 83 To 87CopyRowToSheet ws, i, "PC83_87"Case 68 To 81, 88 To 92CopyRowToSheet ws, i, "PC68_92"End SelectEnd IfNext i' 调整所有新工作表的列宽AdjustAllSheetsApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueMsgBox "数据分类完成！", vbInformation
End SubSub DeleteExistingSheets()Dim ws As WorksheetFor Each ws In ThisWorkbook.WorksheetsIf ws.Name Like "PC*" Thenws.DeleteEnd IfNext ws
End SubSub CreateNewSheets()Dim sheetNames As VariantDim i As LongsheetNames = Array("PC01_11", "PC12_22", "PC23_44", "PC45_67", "PC82", "PC83_87", "PC68_92")For i = 0 To UBound(sheetNames)Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sheetNames(i)Next i
End SubSub CopyHeaders(sourceWs As Worksheet)Dim ws As WorksheetFor Each ws In ThisWorkbook.WorksheetsIf ws.Name Like "PC*" ThensourceWs.Rows(1).Copy ws.Rows(1)End IfNext ws
End SubSub CopyRowToSheet(sourceWs As Worksheet, rowNum As Long, targetSheet As String)Dim targetRow As Long' 获取目标工作表的下一个空行targetRow = Worksheets(targetSheet).Cells(Worksheets(targetSheet).Rows.Count, "B").End(xlUp).Row + 1' 复制整行数据sourceWs.Rows(rowNum).Copy Worksheets(targetSheet).Rows(targetRow)
End SubSub AdjustAllSheets()Dim ws As WorksheetFor Each ws In ThisWorkbook.WorksheetsIf ws.Name Like "PC*" Thenws.Columns.AutoFitEnd IfNext ws
End Sub
