【Excel】【VBA】根据某列的编号顺序筛选对应的行导入相应的sheet中
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 Worksheet
Dim lastRow As Long
Dim i As Long
Dim pcNum As Integer
' 设置当前工作表
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' 删除现有的分组工作表
DeleteExistingSheets
' 创建新工作表
CreateNewSheets
' 复制标题行到每个新表
CopyHeaders ws
' 处理每一行数据
For i = 2 To lastRow
If Left(ws.Cells(i, 2).Value, 2) = "PC" Then
pcNum = CInt(Mid(ws.Cells(i, 2).Value, 3, InStr(ws.Cells(i, 2).Value, "-") - 3))
' 根据PC编号分组
Select Case pcNum
Case 1 To 11
CopyRowToSheet ws, i, "PC01_11"
Case 12 To 22
CopyRowToSheet ws, i, "PC12_22"
Case 23 To 44
CopyRowToSheet ws, i, "PC23_44"
Case 45 To 67
CopyRowToSheet ws, i, "PC45_67"
Case 82
CopyRowToSheet ws, i, "PC82"
Case 83 To 87
CopyRowToSheet ws, i, "PC83_87"
Case 68 To 81, 88 To 92
CopyRowToSheet ws, i, "PC68_92"
End Select
End If
Next i
' 调整所有新工作表的列宽
AdjustAllSheets
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "数据分类完成！", vbInformation
End Sub
Sub DeleteExistingSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "PC*" Then
ws.Delete
End If
Next ws
End Sub
Sub CreateNewSheets()
Dim sheetNames As Variant
Dim i As Long
sheetNames = 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 Sub
Sub CopyHeaders(sourceWs As Worksheet)
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "PC*" Then
sourceWs.Rows(1).Copy ws.Rows(1)
End If
Next ws
End Sub
Sub 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 Sub
Sub AdjustAllSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "PC*" Then
ws.Columns.AutoFit
End If
Next ws
End Sub