[Python] 纯文本查看 复制代码
Option Explicit
Sub 分列()
'工作表根据各项目类别进行分列
Dim rowNum As Integer, colNum As Integer, sh As Worksheet
Dim k As Boolean, i As Integer, j As Integer
Dim inputCol As Integer, inputRow As Integer
k = True
'根据用户选择，对哪一列的内容进行分列。
inputCol = InputBox("要拆分第几列的数据？")
'因为每个表的标题行数不一样，手动让用户输入
inputRow = InputBox("标题行在第几行?")
'rowNum：获取sheets(1)的总行数
'colNum：获取sheets(1)的总列数
rowNum = ThisWorkbook.Worksheets(1).Cells(inputRow, 1).End(xlDown).row
colNum = ThisWorkbook.Worksheets(1).Cells(1, inputRow).End(xlToRight).Column
'根据要分的列，遍历用户输入的行数+1到总行数，确定要新建多少个sheets
For i = inputRow + 1 To rowNum
For Each sh In Sheets
'判断单元格内容，如果表名已存在，就不干啥
If sh.Name = Sheets(1).Cells(i, inputCol) Then
k = False
Exit For
End If
Next
If k = True Then
'判断单元格内容，如果表名不存在，就新建一张表，命名为这个单元格的内容
Sheets.Add(after:=Sheets(Sheets.Count)).Name = Sheets(1).Cells(i, inputCol)
End If
k = True
Next
'新建完sheets后，筛选sheets(1)表格，复制到每张表里
For i = 2 To Sheets.Count
'从sheets(2)开始，先清除表格内容，防止存在其他内容，并设置为文本格式，防止身份证等长数字复制出错
Sheets(i).Cells.ClearContents
Sheets(i).Cells.NumberFormat = "@"
'根据用户输入的函数进行筛选
Sheets(1).Select
Rows(inputRow).Select
Selection.AutoFilter
'根据输入要分列的列数，匹配各sheets名称，对应名称复制过去
Cells(inputRow, 1).AutoFilter Field:=inputCol, Criteria1:=Sheets(i).Name
Sheets(1).Range(Cells(1, 1), Cells(rowNum, colNum)).Copy Sheets(i).Range("A1")
Sheets(1).Cells(inputRow, 1).AutoFilter
Next
'让每个生成完毕的表格的列宽度和sheets(1)的宽度一致
For i = 2 To Worksheets.Count
For j = 1 To colNum
Sheets(i).Columns(j).ColumnWidth = Sheets(1).Columns(j).ColumnWidth
Next j
Next i
'全部完成后，返回到sheets(1)
Sheets(1).Select
End Sub | 
[复制链接]
发表于 2022-5-16 15:57
|
发表于 2022-5-16 17:11
