
一、Excel宏代码
Sub 按列数据类型拆分工作表()
Dim arr, dict As Object
Set dict = CreateObject("scripting.dictionary")
rueq = Val(InputBox("请输入标题的行数", "提醒"))
If rueq < 0 Then MsgBox "标题行数不能为负数。", 64, "警告": Exit Sub
title_row = rueq
trow = Val(InputBox("要根据第几列数据拆分", "提醒"))
If trow < 0 Then MsgBox "列数不能为负数。", 64, "警告": Exit Sub
num_col = trow
Set ws = Application.ActiveSheet
arr = ActiveSheet.UsedRange
For i = title_row + 1 To UBound(arr):
If Not dict.Exists(arr(i, num_col)) Then
Set dict(arr(i, num_col)) = Rows(i)
Else
Set dict(arr(i, num_col)) = Union(dict(arr(i, num_col)), Rows(i))
End If
Next
k = dict.Keys
v = dict.Items
For i = 0 To dict.Count - 1:
Worksheets.Add(after:=Sheets(Sheets.Count)).Name = k(i)
With ActiveSheet
ws.Rows(1).Copy
.[a1].PasteSpecial Paste:=xlPasteColumnWidths
ws.Rows(1 & ":" & title_row).Copy .[a1]
v(i).Copy .Range("A" & title_row + 1)
End With
Next
MsgBox "数据拆分完成", 0, "潮普哥带你学Excel"
End Sub
二、WPS宏代码
function 按列数据类型拆分工作表(){
var qwe=InputBox("请输入标题的行数");
var cetar=Number(qwe)+1
var ttt="a"+cetar
var qae=InputBox("请输入要按第几列的数据进行拆分");
var diao=ActiveSheet
var BIAO=ActiveSheet.UsedRange.Value2;
var arr=BIAO.slice(qwe);
var clnCount=arr[0].length;
var m=new Map();
for (var ar of arr){
if(m.has(ar[qae-1])){
var newarr=m.get(ar[qae-1]).concat([ar]);
m.set(ar[qae-1],newarr);
}else{
m.set(ar[qae-1],[ar])
}
}
for (var [key,val] of m){
var ws=Sheets.Add(null,ActiveSheet);ws.Name=key;
diao.Range("a1","XFD"+qwe).Copy();
ws.Range("a1").Select();
Selection.PasteSpecial(xlPasteColumnWidths, xlPasteSpecialOperationNone, false, false);
ActiveSheet.Paste(undefined, undefined);
ws.Range(ttt).Resize(val.length,clnCount).Value2=val;
Range(ttt,"XFD"+1048576).Select();
Selection.HorizontalAlignment = xlHAlignCenter;
}
MsgBox("数据拆分完成",0,"潮普哥带你学Excel");
}