簡體   English   中英

使用VBA遍歷工作表代號數組

[英]Using VBA to Loop through Array of Worksheet CodeNames

我試圖通過VBA遍歷一系列特定的工作表,但始終會出錯。 我已經在這里待了一個多星期了,終於把自己帶到這里了。 我目前擁有的代碼如下:

Option Explicit
Sub Create_NewEvent2()

Dim i As Variant, wName As Variant, x As Variant, ws As Worksheet
wName = Array("Sheet1", "Sheet3", "Sheet5", "Sheet7", "Sheet9", _
"Sheet13", "Sheet17", "Sheet21", "Sheet23", "Sheet27", "Sheet31", _ 
"Sheet35", "Sheet39", "Sheet43", "Sheet47", "Sheet54", _
"Sheet56", "Sheet57", "Sheet58", "Sheet60", "Sheet61", "Sheet62", _ 
"Sheet63", "Sheet64", "Sheet65", "Sheet82", "Sheet83", "Sheet84", _
 "Sheet85", "Sheet90", "Sheet91", "Sheet93", "Sheet94")


For Each ws In ActiveWorkbook.Worksheets
For i = LBound(wName) To UBound(wName)
If ws.CodeName = wName(i) Then
 ws.Visible = xlSheetVisible
  ws.Range("M7:M38").Select
   Selection.Copy
    ws.Range("D7").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
     Application.CutCopyMode = False
      ws.Range("G7:M38,E7:E38,P43:P45").Select
        ws.Range("P43").Activate
         Selection.ClearContents
          ws.Visible = xlSheetVeryHidden
    Call AutoStock
     End If
 Next i
 Next ws
 End Sub

我從最后這段代碼中獲得的錯誤消息是“范圍類的選擇方法失敗”。 當我調試時,它突出顯示了“ ws.Range(“ M7:M38”)。Select“,但是我在其他代碼中使用了這種確切的語法,效果很好。 誰能告訴我我在哪里出錯了? 任何幫助將不勝感激..

Worksheet.CodeName實際上返回一個Worksheet對象 您可以直接使用它們構建數組。

Sub Create_NewEvent2()

    Dim w As Long, vCODENAMEs As Variant

    vCODENAMEs = Array(Sheet1, Sheet3, Sheet5, Sheet7, Sheet9, Sheet13, _
                       Sheet17, Sheet21, Sheet23, Sheet27, Sheet31, Sheet35, _
                       Sheet39, Sheet43, Sheet47, Sheet54, Sheet56, Sheet57, _
                       Sheet58, Sheet60, Sheet61, Sheet62, Sheet63, Sheet64, _
                       Sheet65, Sheet82, Sheet83, Sheet84, Sheet85, Sheet90, _
                       Sheet91, Sheet93, Sheet94)

    For w = LBound(vCODENAMEs) To UBound(vCODENAMEs)
        With vCODENAMEs(w)
            Debug.Print .Name  'string name of the worksheet
            ' all of your other operations here
            '.Visible = xlSheetVisible  'you do not have to unhide for the operations you've chosen if you reference directly
            .Range("D7:D38") = .Range("M7:M38").Value
            .Range("E7:E38,G7:M38,P43:P45").ClearContents
            .Visible = xlSheetVeryHidden
            Call AutoStock
        End With
    Next w

End Sub

通過直接工作表和單元格引用,我完全避免了所有.Activate.Select廢話。 有關擺脫依賴於選擇和激活來實現目標的更多方法,請參見如何避免在Excel VBA宏中使用“選擇”

Select在無效的工作表上不起作用。 呼叫ws.Activate首先,然后Select應該工作。

參見帶有少量修改和注釋的修訂代碼。 我建議不要使用ActiveWorkbook因為不一定要使用ActiveWorkbook 此外,也無需選擇您要處理的范圍(@Jeeped引用的注釋和文檔)

Sub Create_NewEvent2_New()
Dim wName As Variant, vName As Variant
wName = Array("Sheet1", "Sheet3", "Sheet5", "Sheet7", "Sheet9", _
    "Sheet13", "Sheet17", "Sheet21", "Sheet23", "Sheet27", "Sheet31", _
    "Sheet35", "Sheet39", "Sheet43", "Sheet47", "Sheet54", _
    "Sheet56", "Sheet57", "Sheet58", "Sheet60", "Sheet61", "Sheet62", _
    "Sheet63", "Sheet64", "Sheet65", "Sheet82", "Sheet83", "Sheet84", _
    "Sheet85", "Sheet90", "Sheet91", "Sheet93", "Sheet94")

Dim Wbk As Workbook 'Set workbook variable don't use ActiveWorkbook
Dim ws As Worksheet

    Rem Set Workbook - Change as needed if applied to another workbook.
    Set Wbk = ThisWorkbook

    Rem Loop thru List of Worksheets instead of All Worksheets
    For Each vName In wName

        Set ws = Nothing
        On Error Resume Next
        Set ws = Wbk.Worksheets(vName)
        On Error GoTo 0
        If Not (ws Is Nothing) Then
            With ws
                .Visible = xlSheetVisible
                .Range("M7:M38").Copy
                .Range("D7").PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
                .Range("G7:M38,E7:E38,P43:P45").ClearContents
                .Visible = xlSheetVeryHidden
            End With
            Call AutoStock

    End If: Next

End Sub

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM