使用 excel VBA 激活工作表

Question

我在文件夹中有一个文件“工作簿 A”。每两周向我发送一个更新版本。我想从另一个工作簿“工作簿 B”打开此工作簿，同时删除“工作簿 A”中的空白行。

打开和删除操作将通过使用宏来进行。

这是我迄今为止的代码。

Sub RemoveEmptyRows()
    ' this macro will remove all rows that contain no data
    ' ive named 2 variables of data type string
    Dim file_name  As String
    Dim sheet_name As String

    file_name = "C:\Users\Desktop\Workstation_A\Workbook_A.xlsm"
    'Change to whatever file i want
    sheet_name = "Worksheet_A"   'Change to whatever sheet i want

    ' variables "i" and "LastRow" are needed for the for loop
    Dim i As Long
    Dim LastRow As Long

    ' we set wb as a new work book since we have to open it
    Dim wb As New Workbook

    ' To open and activate workbook
    ' it opens and activates the workbook_A and activates the worksheet_A
    Set wb = Application.Workbooks.Open(file_name)
    wb.Sheets(sheet_name).Activate

    ' (xlCellTypeLastCell).Row is used to find the last cell of the last row
    ' i have also turned off screen updating
    LastRow = wb.ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    Application.ScreenUpdating = False

    ' here i am using a step
    ' the step is negative
    ' therefore i start from the last row and go to the 1st in steps of 1
    For i = LastRow To 1 Step -1
    ' Count A - Counts the number of cells that are not empty and the
    ' values within the list of arguments (wb..ActiveSheet.Rows(i))
    ' Afterwards deleting the rows that are totally blank
        If WorksheetFunction.CountA(wb.ActiveSheet.Rows(i)) = 0 Then
            wb.ActiveSheet.Rows(i).EntireRow.Delete
        End If
    Next i

    ' used to update screen
    Application.ScreenUpdating = True
End Sub

工作表名称包含Worksheet_A 作为其名称的一部分，后跟日期。例如Worksheet_A 11-2-15。

在我的代码中，我已将变量sheet_name 分配给Worksheet_A

sheet_name = "Worksheet_A" 

我用过的更远

.Sheets(sheet_name).Activate

激活工作表。我觉得下面这行有问题：

sheet_name = "Worksheet_A"

因为 sheet_name 不完全是 Worksheet_A，它只包含 Worksheet_A 作为其名称的一部分。

这导致了一个问题。工作簿 A 打开，但没有删除空白行。
此外，还会显示一条错误消息。

运行时错误 9：下标超出范围。

如何修改我的代码以激活工作表并执行宏操作？

Answer 1

is it possible to solve this by using Like or Contain statements?
从你的评论来看，是的。打开工作簿后，像这样迭代工作表集合：

Dim sh As Worksheet
For Each sh In wb.Sheets
    If InStr(sh.Name, "WorkSheet_A") <> 0 Then
        sheet_Name = sh.Name: Exit For
    End If
Next

或者您可以抓住该对象并直接对其进行处理。

Dim sh As Worksheet, mysh As Worksheet
For Each sh In wb.Sheets
    If InStr(sh.Name, "WorkSheet_A") <> 0 Then
        Set mysh = sh: Exit For
    End If
Next

LastRow = mysh.Cells.SpecialCells(xlCellTypeLastCell).Row
'~~> rest of your code here

如果您只有一 (1) 个工作表，则可以通过索引访问它。

Set mysh = wb.Sheets(1)

您可能会发现这个POST 很有趣，它讨论了如何避免Select/Activate/Active 以在未来进一步改进您的编码。 HTH。

这是为您量身定制的代码：

Sub RemoveEmptyRows()
    Dim file_name  As String

    file_name = "C:\Users\Desktop\Workstation_A\Workbook_A.xlsm"
    Dim i As Long
    Dim LastRow As Long

    Dim wb As Workbook, mysh As Worksheet
    Set wb = Application.Workbooks.Open(file_name)
    'Above code is same as yours

    Set mysh = wb.Sheets(1) 'if only one sheet, use loop otherwise

    Application.ScreenUpdating = False
    Dim rngtodelete As Range
    With mysh
        LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
        'Collect all the range for deletion first
        For i = LastRow To 1 Step -1
            If WorksheetFunction.CountA(.Rows(i)) = 0 Then
                If rngtodelete Is Nothing Then
                    Set rngtodelete = .Rows(i)
                Else
                    Set rngtodelete = Union(rngtodelete, .Rows(i))
                End If
            End If
        Next i
    End With
    'Delete in one go
    If Not rngtodelete Is Nothing Then rngtodelete.Delete xlUp
    Application.ScreenUpdating = True
End Sub

Answer 2

工作表是 .select，工作簿是 .activate。

试试

.Sheets(sheet_name).Select

我建议您构建一个字符串或范围，而不是一次删除一行，然后在最后进行一次批量删除。下面是一个示例，可以帮助您上路：

Sub delete_rows()
Dim MyRows As String
For i = 27 To 1 Step -1
    If WorksheetFunction.CountA(ActiveSheet.Rows(i)) = 0 Then
        MyRows = MyRows & "$" & i & ":$" & i & ","
        'wb.ActiveSheet.Rows(i).EntireRow.Delete
    End If
Next i
MyRows = Left(MyRows, Len(MyRows) - 1)
Range(MyRows).Delete
End Sub