我目前正在使用來自 Kutools 的 VBA 代碼，它可以讓我將所有作業表組合成一個組合的“主”表。但是，每個相關的作業表前面都有一個不相關的作業表，應該也不能合并。所以我需要先洗掉作業表 1,3,5... 才能使代碼正常作業。
或者，忽略這些作業表并僅組合所有其他作業表（2、4、6 ...）也可以。
這是我使用的 VBA 代碼：
Sub Combine()
'UpdateByKutools20151029
Dim i As Integer
Dim xTCount As Variant
Dim xWs As Worksheet
On Error Resume Next
LInput:
xTCount = Application.InputBox("The number of title rows", "", "1")
If TypeName(xTCount) = "Boolean" Then Exit Sub
If Not IsNumeric(xTCount) Then
MsgBox "Only can enter number", , "Kutools for Excel"
GoTo LInput
End If
Set xWs = ActiveWorkbook.Worksheets.Add(Sheets(1))
xWs.Name = "Combined"
Worksheets(2).Range("A1").EntireRow.Copy Destination:=xWs.Range("A1")
For i = 2 To Worksheets.Count
Worksheets(i).Range("A1").CurrentRegion.Offset(CInt(xTCount), 0).Copy _
Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row 1, 1)
Next
End Sub
謝謝你的幫助！
uj5u.com熱心網友回復：
通常，當我們從集合中洗掉專案時，我們會向后迭代以避免專案從其原始位置移動。在這里，我創建了一個包含所有奇數作業表名稱的陣列，并使用它在一次操作中洗掉它們。
Sub ReplaceOddWorksheets()
Const Delimiter As String = "\"
Dim SheetNames As String
Dim n As Long
For n = 1 To Worksheets.Count Step 2
SheetNames = SheetNames & Delimiter & Worksheets(n).Name
Next
SheetNames = Mid(SheetNames, 2)
Application.DisplayAlerts = False
Sheets(Split(SheetNames, Delimiter)).Delete
Application.DisplayAlerts = True
End Sub
uj5u.com熱心網友回復：
從每個其他作業表中復制資料
Sub CombineEveryOtherWorksheet()
Const wsName As String = "Combined"
Dim hrCount As Variant
Dim msg As Long
Do
hrCount = Application.InputBox("The number of title rows", "", "1")
If TypeName(hrCount) = "Boolean" Then Exit Sub
If IsNumeric(hrCount) Then Exit Do
msg = MsgBox("Please enter a whole number.", _
vbExclamation vbYesNo, "Try again?")
If msg = vbNo Then Exit Sub
Loop
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim dws As Worksheet
On Error Resume Next
Set dws = wb.Worksheets(wsName)
On Error GoTo 0
If Not dws Is Nothing Then
msg = MsgBox("The worksheet already exists. " _
& "Do you want to delete it?", vbExclamation vbYesNo, "Continue?")
If msg = vbNo Then
Exit Sub
Else
Application.DisplayAlerts = False
dws.Delete
Application.DisplayAlerts = True
End If
End If
wb.Worksheets(1).Copy Before:=wb.Sheets(1)
Set dws = wb.Worksheets(1)
dws.Name = wsName
Dim wsCount As Long: wsCount = wb.Worksheets.Count
If wsCount < 4 Then Exit Sub
Dim dfCell As Range
Set dfCell = dws.Cells(dws.Range("A1").CurrentRegion.Rows.Count 1, "A")
Dim srg As Range
Dim n As Long
For n = 4 To wb.Worksheets.Count Step 2
With wb.Worksheets(n).Range("A1").CurrentRegion
Set srg = .Resize(.Rows.Count - hrCount).Offset(hrCount)
End With
srg.Copy dfCell
Set dfCell = dfCell.Offset(srg.Rows.Count)
Next n
MsgBox "Master worksheet created.", vbInformation
End Sub
uj5u.com熱心網友回復：
如果您只想洗掉作業表 1,3,5,...
Dim i As Long
Dim LastWk As Integer
'delete odds worksheets
'first we must check if last worksheet is odd or even
LastWk = Worksheets.Count
LastWk = IIf(Application.WorksheetFunction.IsOdd(LastWk), LastWk, LastWk - 1)
For i = LastWk To 1 Step -2
Application.DisplayAlerts = False
Worksheets(i).Delete
Application.DisplayAlerts = True
Next i
您只需要一個回圈，但使用可選引數Step（每次回圈都會更改金額計數器。如果未指定，則 step 默認為一。）
我們向后迭代，因此洗掉作業表時索引不會改變
對于...下一個陳述句
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/472660.html