【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 常用声明

1. Dim ws As Worksheet        ' 工作表对象声明
2. Dim lastRow As Long        ' 长整型变量
3. Dim sheetNames As Variant  ' 变体类型数组

复制代码

4.2 工作表操纵

1. Set ws = ActiveSheet                          ' 获取活动工作表
2. lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row  ' 获取最后一行
3. Worksheets.Add                                ' 添加新工作表
4. ws.Delete                                     ' 删除工作表

复制代码

4.3 字符串处理

1. Left(string, length)       ' 获取左侧字符
2. Mid(string, start, length) ' 获取中间字符
3. InStr(string, substring)   ' 查找子字符串位置

复制代码

4.4 数据复制

1. sourceWs.Rows(1).Copy destination  ' 复制整行

复制代码

4.5 应用程序控制

1. Application.ScreenUpdating = False  ' 关闭屏幕刷新
2. Application.DisplayAlerts = False   ' 关闭警告提示

复制代码

4.6 条件判定

1. If condition Then          ' IF语句
2. Select Case value          ' Select Case语句

复制代码

4.7 循环布局

1. For Each ... In ...        ' 集合遍历
2. 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. 性能优化阐明

• 关闭屏幕革新进步运行速度
  
• 关闭告诫消息避免中断
  
• 利用直接复制而非数组操纵
  
• 统一处理工作表创建和删除
  

1. Sub SplitDataFaster()
2.     Dim ws As Worksheet
3.     Dim lastRow As Long
4.     Dim i As Long
5.     Dim pcNum As Integer
6.    
7.     ' 设置当前工作表
8.     Set ws = ActiveSheet
9.     lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
10.    
11.     Application.ScreenUpdating = False
12.     Application.DisplayAlerts = False
13.    
14.     ' 删除现有的分组工作表
15.     DeleteExistingSheets
16.    
17.     ' 创建新工作表
18.     CreateNewSheets
19.    
20.     ' 复制标题行到每个新表
21.     CopyHeaders ws
22.    
23.     ' 处理每一行数据
24.     For i = 2 To lastRow
25.         If Left(ws.Cells(i, 2).Value, 2) = "PC" Then
26.             pcNum = CInt(Mid(ws.Cells(i, 2).Value, 3, InStr(ws.Cells(i, 2).Value, "-") - 3))
27.             
28.             ' 根据PC编号分组
29.             Select Case pcNum
30.                 Case 1 To 11
31.                     CopyRowToSheet ws, i, "PC01_11"
32.                 Case 12 To 22
33.                     CopyRowToSheet ws, i, "PC12_22"
34.                 Case 23 To 44
35.                     CopyRowToSheet ws, i, "PC23_44"
36.                 Case 45 To 67
37.                     CopyRowToSheet ws, i, "PC45_67"
38.                 Case 82
39.                     CopyRowToSheet ws, i, "PC82"
40.                 Case 83 To 87
41.                     CopyRowToSheet ws, i, "PC83_87"
42.                 Case 68 To 81, 88 To 92
43.                     CopyRowToSheet ws, i, "PC68_92"
44.             End Select
45.         End If
46.     Next i
47.    
48.     ' 调整所有新工作表的列宽
49.     AdjustAllSheets
50.    
51.     Application.ScreenUpdating = True
52.     Application.DisplayAlerts = True
53.    
54.     MsgBox "数据分类完成！", vbInformation
55. End Sub
57. Sub DeleteExistingSheets()
58.     Dim ws As Worksheet
59.     For Each ws In ThisWorkbook.Worksheets
60.         If ws.Name Like "PC*" Then
61.             ws.Delete
62.         End If
63.     Next ws
64. End Sub
66. Sub CreateNewSheets()
67.     Dim sheetNames As Variant
68.     Dim i As Long
69.    
70.     sheetNames = Array("PC01_11", "PC12_22", "PC23_44", "PC45_67", "PC82", "PC83_87", "PC68_92")
71.    
72.     For i = 0 To UBound(sheetNames)
73.         Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sheetNames(i)
74.     Next i
75. End Sub
77. Sub CopyHeaders(sourceWs As Worksheet)
78.     Dim ws As Worksheet
79.     For Each ws In ThisWorkbook.Worksheets
80.         If ws.Name Like "PC*" Then
81.             sourceWs.Rows(1).Copy ws.Rows(1)
82.         End If
83.     Next ws
84. End Sub
86. Sub CopyRowToSheet(sourceWs As Worksheet, rowNum As Long, targetSheet As String)
87.     Dim targetRow As Long
88.    
89.     ' 获取目标工作表的下一个空行
90.     targetRow = Worksheets(targetSheet).Cells(Worksheets(targetSheet).Rows.Count, "B").End(xlUp).Row + 1
91.    
92.     ' 复制整行数据
93.     sourceWs.Rows(rowNum).Copy Worksheets(targetSheet).Rows(targetRow)
94. End Sub
96. Sub AdjustAllSheets()
97.     Dim ws As Worksheet
98.     For Each ws In ThisWorkbook.Worksheets
99.         If ws.Name Like "PC*" Then
100.             ws.Columns.AutoFit
101.         End If
102.     Next ws
103. End Sub

复制代码

免责声明：如果侵犯了您的权益，请联系站长，我们会及时删除侵权内容，谢谢合作！更多信息从访问主页：qidao123.com:ToB企服之家，中国第一个企服评测及商务社交产业平台。