2015-02-23 278 views
4

我在文件夾中有一個「工作簿A」文件。每兩週發送一次更新的版本給我。我想從另一個工作簿「工作簿B」打開此工作簿,同時刪除「工作簿A」中的空白行。使用excel激活工作表VBA

打開和刪除操作將通過使用宏來進行。

這是我迄今爲止的代碼。

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_nameWorksheet_A

sheet_name = "Worksheet_A" 

進一步壓低我用

.Sheets(sheet_name).Activate 

激活工作表。我覺得有下面一行的一個問題:

sheet_name = "Worksheet_A" 

因爲sheet_name是不完全Worksheet_A它只包含Worksheet_A作爲其名稱的一部分。

這是造成problem.The工作簿中打開,但不會出現空白行的刪除。
此外還會顯示一條錯誤消息。

運行時錯誤9:下標超出範圍。

如何修改我的代碼以便工作表被激活並執行宏操作?

回答

7

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其中討論如何避免選擇/激活/主動進一步提高您在未來的編碼。 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 
+0

是的,我只有一張工作表 – tania 2015-02-23 05:33:37

+0

非常感謝你 它完美地工作 這真的很有幫助 謝謝你花時間給我啓發。這非常有教育意義。 – tania 2015-02-23 05:53:07

3

工作表是.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 
+0

我仍然得到相同的錯誤之前,甚至.Activate改變後。選擇 – tania 2015-02-23 05:02:59

+1

是否有可能通過使用像或者包含語句來解決這個問題? – tania 2015-02-23 05:13:30

相關問題