|
Public Sub splitAll(ByVal sheetName As String, ByVal x As Integer)
Dim MyPath, MyName, AWbName, MyUpPath, arr
Dim Wb, WbA As Workbook
Dim WbSheet, WbASheet As Worksheet
Dim WbOpen, WbAOpen As Boolean
Dim i, j, k, n, m, y As Double
Dim WbValue, WbValue1, WbValue2, WbAValue, WbAValue1, WbAValue2 As String
Dim bookName
Application.ScreenUpdating = False
MyPath = ThisWorkbook.Path
MyUpPath = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 1)
'''///判断并打开“合并的母表”是否已打开
For Each Wb In Workbooks
If Wb.Name = "广东00广东明细表.xlsx" Then
Wb.Activate
WbOpen = True
Exit For
Else
WbOpen = False
End If
Next Wb
If Not WbOpen Then
Set Wb = Workbooks.Open(MyUpPath & "\" & "广东00广东明细表.xlsx", False)
End If
Set WbSheet = Wb.Worksheets(sheetName)
WbSheet.Activate
m = WbSheet.Range("A65535").End(xlUp).Row
For i = 9 To m
If WbSheet.Cells(i, x).Interior.Color <> 500 Then
WbValue = Mid(WbSheet.Cells(i, x), 5, 2)
WbSheet.Cells(i, x).Interior.Color = 500
bookName = MyPath & "\" & WbValue & ".xlsx"
Else
GoTo Label2
End If
If CreateObject("scripting.filesystemobject").FileExists(bookName) = False Then
Set WbA = Workbooks.Add
With WbA
.SaveAs FileName:=WbValue & ".xlsx"
End With
Else
For Each WbA In Workbooks
If WbA.Name = WbValue & ".xlsx" Then
WbA.Activate
WbAOpen = True
Exit For
Else
WbAOpen = False
End If
Next WbA
If Not WbAOpen Then
Set WbA = Workbooks.Open(MyPath & "\" & WbValue & ".xlsx", False)
End If
End If
WbA.Activate
On Error GoTo err1
Set WbASheet = WbA.Worksheets(sheetName)
label3:
WbSheet.Rows("1:8").Copy WbASheet.Rows("1:8")
''''''******
WbASheet.Activate
With WbASheet
WbSheet.Rows(i).Copy .Cells(9, 1)
End With
'''''''****
For j = i + 1 To m
If WbSheet.Cells(j, x).Interior.Color <> 500 Then
WbValue1 = Mid(WbSheet.Cells(j, x), 5, 2)
If WbValue = WbValue1 Then
WbSheet.Cells(j, x).Interior.Color = 500
WbASheet.Activate
n = WbASheet.Range("A65536").End(xlUp).Row
With WbASheet
WbSheet.Rows(j).Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
End With
End If
End If
Next
WbA.Save
WbA.Close False
Set WbA = Nothing
Label2:
Next
Application.ScreenUpdating = True
MsgBox sheetName & "表的数据拆分完成!"
err1:
WbA.Activate
Set WbASheet = Worksheets.Add
WbASheet.Name = sheetName
GoTo label3
End Sub
红色字体标注“错误捕获”处,为什么第一次就可以正常跳转到“err1:”,第二次就报错。终止程序重新执行也是上述情况——小女子才思学浅,求各位大牛哥哥指导,O(∩_∩)O谢谢
|
|