文章摘要
这篇文章介绍了一个使用Visual Basic脚本处理Excel数据的程序。该程序首先通过`InputBox`获取拆分列号,并检查是否存在输入。接着,它通过脚本的字典`d`来处理数据,遍历每一行,利用`Union`操作合并重复的数据项。最后,程序将处理后的数据复制到新的工作簿中,并保存为Excel文件。整个过程包括数据提取、合并、复制和保存等步骤,旨在自动化地完成数据处理任务。
? Dim arr, d As Object, k, t, i&, lc%, rng As Range, c%
? c=Application.InputBox(“请输入拆分列号”, , 4, , , , , 1)
? If c=0 Then Exit Sub
? Application.ScreenUpdating=False
? Application.DisplayAlerts=False
? arr=[a1].CurrentRegion
? lc=UBound(arr, 2)
? Set rng=[a1].Resize(, lc)
? Set d=CreateObject(“scripting.dictionary”)
? For i=2 To UBound(arr)
? If Not d.Exists(arr(i, c)) Then
? Set d(arr(i, c))=Cells(i, 1).Resize(1, lc)
? Else
? Set d(arr(i, c))=Union(d(arr(i, c)), Cells(i, 1).Resize(1, lc))
? End If
? Next
? k=d.Keys
? t=d.Items
? For i=0 To d.Count – 1
? With Workbooks.Add(xlWBATWorksheet)
? rng.Copy .Sheets(1).[a1]
? t(i).Copy .Sheets(1).[a2]
? .SaveAs Filename:=ThisWorkbook.Path & “” & k(i) & “.xls”
? .Close
? End With
? Next
? Application.DisplayAlerts=True
? Application.ScreenUpdating=True
? MsgBox “完毕”
End Sub
? c=Application.InputBox(“请输入拆分列号”, , 4, , , , , 1)
? If c=0 Then Exit Sub
? Application.ScreenUpdating=False
? Application.DisplayAlerts=False
? arr=[a1].CurrentRegion
? lc=UBound(arr, 2)
? Set rng=[a1].Resize(, lc)
? Set d=CreateObject(“scripting.dictionary”)
? For i=2 To UBound(arr)
? If Not d.Exists(arr(i, c)) Then
? Set d(arr(i, c))=Cells(i, 1).Resize(1, lc)
? Else
? Set d(arr(i, c))=Union(d(arr(i, c)), Cells(i, 1).Resize(1, lc))
? End If
? Next
? k=d.Keys
? t=d.Items
? For i=0 To d.Count – 1
? With Workbooks.Add(xlWBATWorksheet)
? rng.Copy .Sheets(1).[a1]
? t(i).Copy .Sheets(1).[a2]
? .SaveAs Filename:=ThisWorkbook.Path & “” & k(i) & “.xls”
? .Close
? End With
? Next
? Application.DisplayAlerts=True
? Application.ScreenUpdating=True
? MsgBox “完毕”
End Sub
© 版权声明
文章版权归作者所有,未经允许请勿转载。