「sheet」を含むすべてのシートを削除しようとしています。そして「1」のような数字が続きます。または「25」ワークブックで。機能するコードをいくつか書いていますが、非常に非効率なので、より良い方法が必要です。
私の醜いコードを許してください。
Sub DeleteextraSheets()
Dim xWs As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ActiveWorkbook.Worksheets
If xWs.Name = "Sheet1" Or xWs.Name = "Sheet2" Or xWs.Name = "Sheet3" Or xWs.Name = "Sheet4" Or xWs.Name = "Sheet5" Or xWs.Name = "Sheet6" And xWs.Name = "Sheet7" Or xWs.Name = "Sheet8" Or xWs.Name = "Sheet9" Or xWs.Name = "Sheet10" Or xWs.Name = "Sheet11" Or xWs.Name = "Sheet12" Or xWs.Name = "Sheet13" Or xWs.Name = "Sheet14" Or xWs.Name = "Sheet15" Or xWs.Name = "Sheet16" Or xWs.Name = "Sheet17" Then
xWs.Delete
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
------------------------
「いいね！」の使用:
これは、Sheet で始まり、その後に数字が続くすべてのシートと一致します。
If Left(xWs.Name,6) Like "Sheet#" Then
xWs.Delete
End If
0
------------------------
Shを削除えっ
最初の 2 つのプロシージャにはグラフが含まれ、vbTextCompare が使用されます。
大文字と小文字を区別しないようにするため、つまり A = a となります。どちらの問題も重大な問題である
新しいシートを追加する前にシート名を確認することが重要です。
それらの名前を変更します。削除の場合は、それほど多くはありません。
3 番目と 4 番目のプロシージャでも大文字と小文字は区別されません。つまり、A = a
3 番目の手順では、それが機能するためにすべてのシート名を知っている必要があります。
4 番目の手順では、シート名はわかっているものの、ワークブック内にその一部しか出現しない可能性がある場合のシナリオを取り上げます。
コード
Option Explicit
' If they start with a common string:
Sub deleteExtraSheets()
Const CommonString As String = "Sheet"
Dim wb As Workbook: Set wb = ActiveWorkbook
' Define Sheets Array.
Dim Data As Variant
ReDim Data(wb.Sheets.Count - 1)
' The 'Sheets' collection includes charts, but there is no 'Sheet' object.
Dim sh As Object
Dim j As Long
j = -1
For Each sh In wb.Sheets
' vbTextCompare means 'A = a'.
If StrComp(Left(sh.Name, Len(CommonString)), CommonString, _
vbTextCompare) = 0 Then
j = j + 1
Data(j) = sh.Name
End If
Next sh
If j > -1 Then
ReDim Preserve Data(j)
Application.DisplayAlerts = False
wb.Sheets(Data).Delete
Application.DisplayAlerts = True
End If
End Sub
' If they contain a common string:
Sub deleteExtraSheets2()
Const CommonString As String = "Sheet"
' I prefer 'ThisWorkbook', the workbook containing this code.
Dim wb As Workbook: Set wb = ActiveWorkbook
' Define Sheets Array.
Dim Data As Variant
ReDim Data(wb.Sheets.Count - 1)
' The 'Sheets' collection includes charts, but there is no 'Sheet' object.
Dim sh As Object
Dim j As Long
j = -1
For Each sh In wb.Sheets
' vbTextCompare means 'A = a'.
If InStr(1, sh.Name, CommonString, vbTextCompare) > 0 Then
j = j + 1
Data(j) = sh.Name
End If
Next sh
If j > -1 Then
ReDim Preserve Data(j)
Application.DisplayAlerts = False
wb.Sheets(Data).Delete
Application.DisplayAlerts = True
End If
End Sub
' If you know their names:
Sub deleteExtraSheets3()
Dim Data As Variant
Data = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", _
"Sheet6", "Sheet7", "Sheet8", "Sheet9", "Sheet10", _
"Sheet11", "Sheet12", "Sheet13", "Sheet14", "Sheet15", _
"Sheet16", "Sheet17")
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(Data).Delete
Application.DisplayAlerts = True
End Sub
' If you know their names and only some of them might occur:
Sub deleteExtraSheets4()
Dim SheetNames As Variant
SheetNames = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", _
"Sheet6", "Sheet7", "Sheet8", "Sheet9", "Sheet10", _
"Sheet11", "Sheet12", "Sheet13", "Sheet14", "Sheet15", _
"Sheet16", "SHEET17")
Dim wb As Workbook: Set wb = ActiveWorkbook
' Define Sheets Array.
Dim Data As Variant
ReDim Data(wb.Sheets.Count - 1)
' The 'Sheets' collection includes charts, but there is no 'Sheet' object.
Dim sh As Object
Dim j As Long
j = -1
For Each sh In wb.Sheets
If Not IsError(Application.Match(sh.Name, SheetNames, 0)) Then
j = j + 1
Data(j) = sh.Name
End If
Next sh
If j > -1 Then
ReDim Preserve Data(j)
Application.DisplayAlerts = False
wb.Sheets(Data).Delete
Application.DisplayAlerts = True
End If
End Sub
