我现在有一个总表,怎么样才能将其按照指定列拆分成多个表格??我在网上查到了下面公式,但是他是从第二行开始拆分的,各位大神,能不能改写一下,改成从的三行还是拆分!!(第一行是合并单元格,第二行是名称,第三行开始是需要拆分的内容)
Sub chaifen()
Dim a, b(), d, icol, c, rng, l
On Error Resume Next
a = Columns("c")
Set rng = Sheet1.UsedRange
1000:
icol = Application.InputBox("请输入需要拆分的列号:", , "请输入A, B, C……", , , , 2)
If icol = "请输入A, B, C……" Then
MsgBox "没有输入拆分列号!": GoTo 1000
ElseIf icol = False Then
Exit Sub
ElseIf Cells(1, icol).Column > rng.End(xlToRight).Column Then
MsgBox "输入的列号无效或已超过有效范围!": GoTo 1000
End If
Application.ScreenUpdating = False
a = Intersect(rng, Columns(icol))
c = rng
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(a)
If Not d.exists(a(i, 1)) Then
d(a(i, 1)) = i
Else
d(a(i, 1)) = d(a(i, 1)) & "," & i
End If
Next i
k = d.keys
p = ThisWorkbook.Path & "\"
For i = 0 To d.Count - 1
x = Split(d(k(i)), ",")
ReDim b(1 To UBound(x) + 2, 1 To UBound(c, 2))
For j = 1 To UBound(c, 2)
b(1, j) = c(1, j)
Next j
m = 1
For l = 0 To UBound(x)
m = m + 1
For j = 1 To UBound(c, 2)
b(m, j) = c(x(l), j)
Next j
Next l
For j = 1 To UBound(c, 2)
If VBA.IsNumeric(b(2, j)) And Len(b(2, j)) >= 12 Then ss = j
Next j
rng.Rows(2).Copy
With Workbooks.Add
.Sheets(1).[a1].Resize(m, UBound(c, 2)).PasteSpecial Paste:=xlPasteFormats
.Sheets(1).Columns(ss).NumberFormatLocal = "@"
.Sheets(1).[a1].Resize(m, UBound(c, 2)) = b
.SaveAs Filename:=p & k(i) & ".xls"
.Close
End With
Next i
MsgBox "拆分完毕!"
Application.ScreenUpdating = True
End Sub
|