Question

我尝试使用.xlsb文件以便在所有不同的工作簿中执行该文件，但是即使我的宏正在针对该特定文件运行，也始终出现错误400。我写了这个简单的代码来删除工作簿中的空行和空列。

Sub RepeatTask()
    Dim xSh As Worksheet
    Application.ScreenUpdating = False
    For Each xSh In Worksheets
        xSh.Select
        Call task
    Next

    Application.ScreenUpdating = True
End Sub

Sub task()
    Dim LastColumnIndex As Integer
    Dim LastRowIndex As Integer
    Dim RowIndex As Integer
    Dim ColumnIndex As Integer
    Dim UsedRng As Range

    Set UsedRng = ActiveSheet.UsedRange
    LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
    LastColumnIndex = UsedRng.Column - 1 + UsedRng.Columns.Count

    Application.ScreenUpdating = False

    For RowIndex = LastRowIndex To 1 Step -1
        If Application.CountA(Rows(RowIndex)) = 0 Then
            Rows(RowIndex).Delete
        End If
    Next RowIndex

    For ColumnIndex = LastColumnIndex To 1 Step -1
        If Application.CountA(Columns(ColumnIndex)) = 0 Then
            Columns(ColumnIndex).Delete
        End If
    Next ColumnIndex

    Application.ScreenUpdating = True

End Sub

Answer 1

我建议不要使用.Select来代替工作表作为参数，并在所有ws.Rows()，ws.Columns()等中指定工作表。

如果您设置参数Optional，并且在没有参数的情况下调用If ws Is Nothing Then Set ws = ActiveSheet，则可以回退到Task。

Sub RepeatTask()
    Dim xSh As Worksheet
    Application.ScreenUpdating = False
    For Each xSh In Worksheets
        Task xSh 'give worksheet as parameter here instead of select!
    Next

    Application.ScreenUpdating = True
End Sub

Sub Task(Optional ws As Worksheet)
    If ws Is Nothing Then Set ws = ActiveSheet

    Dim LastColumnIndex As Long
    Dim LastRowIndex As Long
    Dim RowIndex As Long
    Dim ColumnIndex As Long
    Dim UsedRng As Range

    Set UsedRng = ws.UsedRange
    LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
    LastColumnIndex = UsedRng.Column - 1 + UsedRng.Columns.Count

    Application.ScreenUpdating = False

    For RowIndex = LastRowIndex To 1 Step -1
        If Application.CountA(ws.Rows(RowIndex)) = 0 Then
            ws.Rows(RowIndex).Delete
        End If
    Next RowIndex

    For ColumnIndex = LastColumnIndex To 1 Step -1
        If Application.CountA(ws.Columns(ColumnIndex)) = 0 Then
            ws.Columns(ColumnIndex).Delete
        End If
    Next ColumnIndex

    Application.ScreenUpdating = True
End Sub

Answer 2

我可以为多个Excel工作簿执行此操作的方法是：

Sub OpenFiles()
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String

    On Error Resume Next
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If

    If xStrPath = "" Then Exit Sub
    xFile = Dir(xStrPath & "\*.xlsm")
    Do While xFile <> ""
        Workbooks.Open xStrPath & "\" & xFile
        xFile = Dir
    Loop
    Call Optil
    Call SaveAndCloseAllWorkbooks

End Sub

Sub Optil()
Dim book As Workbook, sheet As Worksheet
Application.ScreenUpdating = False

For Each book In Workbooks
    For Each sheet In book.Worksheets
        Task sheet
    Next sheet
Next book
Application.ScreenUpdating = True

End Sub

Sub RepeatTask()
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets
    Task xSh 'give worksheet as parameter here instead of select!
Next

Application.ScreenUpdating = True
End Sub

Sub Task(Optional ws As Worksheet)
    If ws Is Nothing Then Set ws = ActiveSheet
    Dim LastColumnIndex As Long
    Dim LastRowIndex As Long
    Dim RowIndex As Long
    Dim ColumnIndex As Long
    Dim UsedRng As Range

    Set UsedRng = ws.UsedRange
    LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
    LastColumnIndex = UsedRng.Column - 1 + UsedRng.Columns.Count

    Application.ScreenUpdating = False

    For RowIndex = LastRowIndex To 1 Step -1
        If Application.CountA(ws.Rows(RowIndex)) = 0 Then
            ws.Rows(RowIndex).Delete
        End If
    Next RowIndex

    For ColumnIndex = LastColumnIndex To 1 Step -1
        If Application.CountA(ws.Columns(ColumnIndex)) = 0 Then
            ws.Columns(ColumnIndex).Delete
        End If
    Next ColumnIndex

    Application.ScreenUpdating = True
End Sub

Sub SaveAndCloseAllWorkbooks()
Dim bk As Workbook

For Each bk In Workbooks
    If Not bk Is ThisWorkbook Then
    bk.Close SaveChanges:=True
    End If
 Next bk

'If You want to save and close active workbook too 
'ThisWorkbook.Close SaveChanges:=True 

End Sub

如何为30种不同的Excel工作簿运行相同的宏，VBA代码？

2 个答案: