在本問題中，要將拆分結(jié)果保存在新工作簿中，那可以在執(zhí)行拆分?jǐn)?shù)據(jù)的操作前，先新建工作簿及工作表來保存拆分結(jié)果。
在寫過程前，可以在模塊的開始位置先聲明兩個模塊級變量或公共變量：表示保存拆分結(jié)果的工作簿ToWb和要拆分的數(shù)據(jù)表Sht，如：
Dim ToWb As Workbook, Sht As Worksheet
然后將新建保存結(jié)果的工作簿及工作表的代碼寫為單獨的過程，如：
Sub ShtAdd()
Dim ShtCount As Integer '記錄新建工作簿中包含的工作表數(shù)量
Set ToWb = Workbooks.Add '新建工作簿，并存到變量ToWb中
ShtCount = ToWb.Worksheets.Count
Dim i As Long, ShtName As String
i = 2
'Do循環(huán)語句用于在工作簿中新建保存拆分結(jié)果的工作表
Do While Sht.Cells(i, "A").Value <> ""
ShtName = Sht.Cells(i, "A").Value
If IsSht(ShtName) = False Then 'IF語句判斷指定名稱的工作表是否存在
ToWb.Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = ShtName
Sht.Rows(1).Copy ToWb.Worksheets(ShtName).Rows(1) '復(fù)制表頭到新工作表中
End If
i = i + 1
Loop
'For循環(huán)語句刪除新建的工作簿中原帶的空工作表
Application.DisplayAlerts = False
For i = ShtCount To 1 Step -1
ToWb.Worksheets(i).Delete
Next i
Application.DisplayAlerts = True
End Sub
其中用到一個判斷指定名稱的工作表是否存在的自定義函數(shù)，代碼為：
Function IsSht(ByVal ShtName As String) As Boolean '判斷工作表名稱是否存在
On Error Resume Next
If Worksheets(ShtName) Is Nothing Then
IsSht = False '工作表不存在，函數(shù)值為False
Else
IsSht = True '工作表已存在，函數(shù)值為true
End If
End Function
當(dāng)然，這個判斷工作表是否存在的代碼，也可以直接寫在過程中。
最后，再在原有程中，在執(zhí)行拆分?jǐn)?shù)據(jù)的操作前先調(diào)用上面的子過程ShtAdd，就能解決這個問題了，如：
Sub 拆分?jǐn)?shù)據(jù)到工作表()
Dim ShtName As String, ToRng As Range, i As Integer, DataArr As Variant
Set Sht = ActiveSheet
Call ShtAdd ' 調(diào)用子過程，新建保存拆分結(jié)果的工作表及工作表
i = 2 '要拆分的第一條數(shù)據(jù)的行號
Do While Sht.Cells(i, "A").Value <> ""
ShtName = Sht.Cells(i, "A").Value
Set ToRng = ToWb.Worksheets(ShtName).Range("A1048576").End(xlUp).Offset(1, 0)
DataArr = Sht.Cells(i, "A").Resize(1, 8).Value
ToRng.Resize(1, 8).Value = DataArr '用數(shù)組傳遞數(shù)據(jù)
i = i + 1 '重設(shè)變量的值，以便下次循環(huán)能拆分新的記錄
Loop
End Sub
代碼容器中完成后的代碼截圖如下：
執(zhí)行“拆分?jǐn)?shù)據(jù)到工作表”的過程，就能工作表中的數(shù)據(jù)，按A列的信息拆分到不同工作表，保存在新工作簿中了。
承擔(dān)因您的行為而導(dǎo)致的法律責(zé)任，
本站有權(quán)保留或刪除有爭議評論。
參與本評論即表明您已經(jīng)閱讀并接受
上述條款。