如何删除所有表格

时间:2016-12-27 17:50:28

标签: excel vba

我正在尝试使用Excel 2010中的此代码删除每个工作表中的空行:

Private Sub CommandButton1_Click()

Dim I As Integer

'For all sheets...

For I = 1 To Sheets.Count

    'select corresponding sheet

    Sheets(I).Select

    Sheets(I).Activate

    'write delete code

    For fila = 1 To 10

        If Cells(fila, 4).Value = "" Then

            Rows(fila).Delete

        End If

    Next fila

    'Go to next sheet

Next

End Sub

此代码仅删除我第一张活动工作表上的行。

2 个答案:

答案 0 :(得分:1)

在删除对象时(在您的案例行中)始终记得向后循环,因此请使用For i = 10 to 1 Step -1

另外,尽量避免使用SelectActivate,而是可以直接引用WorksheetRange。在这种情况下,直接使用定义为ws的{​​{1}}来查看是否Worksheet

<强>代码

If ws.Cells(fila, 4).Value = ""

答案 1 :(得分:0)

也许此解决方案将帮助您: 它将清理工作簿中的所有工作表并删除空行。 最后,味精框将告诉您为每张纸删除的行的百分比。 最好的问候,

Sub Clean()
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String, Avant As Double, plage As Range
On Error Resume Next
Calc = Application.Calculation ' ---- mémorisation de l'état de
recalcul
'------------------------------------------------------------
MsgBox "Pour le classeur actif : " _
& Chr(10) & ActiveWorkbook.FullName _
& Chr(10) & "dans chaque feuille de calcul" _
& Chr(10) & "recherche la zone contenant des données," _
& Chr(10) & "réinitialise la dernière cellule utilisée" _
& Chr(10) & "et optimise la taille du fichier Excel", _
vbInformation, _
"d'après LL par <a href="mailto:GeeDee@m6net.fr">GeeDee@m6net.fr</a>"
'-------------------------------------------------------------
MsgBox "Taille initiale de ce classeur en octets" _
& Chr(10) & FileLen(ActiveWorkbook.FullName), _
vbInformation, ActiveWorkbook.FullName
'------------------------------------------------------------
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours..."
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = True
End With
'-------------------- le traitement
For Each Sht In Worksheets
Avant = Sht.UsedRange.Cells.Count
Application.StatusBar = Sht.Name & "-" & Sht.UsedRange.Address
'-------------------Traitement de la zone trouvée
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
'----------------Suppression des lignes inutilisées
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Delete
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2)
'----------------Suppression des colonnes inutilisées
If Not DCell Is Nothing Then Sht.Range(DCell, Sht.[IV1]).EntireColumn.Delete
End If
Rien = Sht.UsedRange.Address
End If
ActiveWorkbook.Save
'---------------------Message pour la feuille traitée
MsgBox "Nom de la feuille de calcul :" _
& Chr(10) & Sht.Name _
& Chr(10) & Format(Sht.UsedRange.Cells.Count / Avant, "0.00%") & " de la taille initiale", _
vbInformation, ActiveWorkbook.FullName
Next Sht
'--------------------Message fin de traitement
MsgBox "Taille optimisée de ce classeur en octets " & Chr(10) & FileLen(ActiveWorkbook.FullName), _
vbInformation, _
ActiveWorkbook.FullNameActive
'--------------------
Application.StatusBar = False
Application.Calculation = Calc
End Sub