试图让这个vba循环遍历当前工作簿中的所有工作表。它贯穿第一个

在完成活动工作簿中的第一个工作表之后，此循环VBA脚本将停止，但需要循环遍历所有工作表。有人能帮助我理解我错过了什么让循环在所有工作表中连续移动吗？试图让这个vba循环遍历当前工作簿中的所有工作表。它贯穿第一个

Sub forEachws() 
Dim ws As Worksheet 
For Each ws In ActiveWorkbook.Worksheets 
    Call Music_Connect_Albums(ws) 
    Next 
End Sub 

Sub Music_Connect_Albums(ws As Worksheet) 
    With ws 
    .Columns("B:H").Select 
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
    .Range("A13").Select 
    ActiveCell.FormulaR1C1 = "Artist" 
    .Range("B13").Select 
    ActiveCell.FormulaR1C1 = "Title" 
    .Range("C13").Select 
    ActiveCell.FormulaR1C1 = "Release" 
    .Range("D13").Select 
    ActiveCell.FormulaR1C1 = "Label" 
    .Range("E13").Select 
    ActiveCell.FormulaR1C1 = "Age" 
    .Range("F13").Select 
    ActiveCell.FormulaR1C1 = "Yr" 
    .Range("G13").Select 
    ActiveCell.FormulaR1C1 = "Wk" 
    .Range("H13").Select 
    ActiveCell.FormulaR1C1 = "Wk-End" 
    .Range("A14").Select 
    ActiveCell.FormulaR1C1 = "=R2C10" 
    .Range("B14").Select 
    ActiveCell.FormulaR1C1 = "=R3C10" 
    .Range("C14").Select 
    ActiveCell.FormulaR1C1 = "=R4C10" 
    .Range("D14").Select 
    ActiveCell.FormulaR1C1 = "=R5C10" 
    .Range("E14").Select 
    ActiveCell.FormulaR1C1 = "=R9C10" 
    .Range("F14").Select 
    ActiveCell.FormulaR1C1 = "=RIGHT(R8C10,4)" 
    .Range("G14").Select 
    ActiveCell.FormulaR1C1 = "=MID(R13C10,6,2)" 
    .Range("G14").Select 
    ActiveCell.FormulaR1C1 = "=MID(R13C13,6,2)" 
    .Range("H14").Select 
    ActiveCell.FormulaR1C1 = "=RIGHT(R8C10,10)" 
    .Range("A14:H14").Select 
    Selection.AutoFill Destination:=Range("A14:H35") 
    .Range("A14:H35").Select 
    .Columns("A:H").Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    .Rows("1:13").Select 
    .Range("A12").Activate 
    .Application.CutCopyMode = False 
    Selection.Delete Shift:=xlUp 
    .Columns("I").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
    End With 
End Sub

来源

2017-06-16 aksnave

按预期方式修改1个工作表后的结果：VBA运行时错误“1004”：范围类的选择方法失败 – aksnave

您需要清除所有'.Select'和'Selection.'参见此处以获取信息：https ：//stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros。 –

^^^^是最好的方法，禁止如果你激活工作表，这是可怕的编码，它应该工作。在'With ws'后面激活'.Activate'。您无法选择不活动工作表上的范围。但认真摆脱激活和选择。它会使代码更快，更可靠。 –

这里是没有.Select或.Activate的快速重写代码。

Option Explicit 

Sub forEachws() 
    Dim ws As Worksheet 
    For Each ws In ActiveWorkbook.Worksheets 
     Call Music_Connect_Albums(ws) 
    Next 
End Sub 

Sub Music_Connect_Albums(ws As Worksheet) 
    With ws 
     .Columns("B:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
     .Range("A13:H13").Value = Array("Artist", "Title", "Release", "Label", _ 
             "Age", "Yr", "Wk", "Wk-End") 
     .Range("A14:H14").FormulaR1C1 = Array("=R2C10", "=R3C10", "=R4C10", "=R5C10", "=R9C10", _ 
               "=RIGHT(R8C10,4)", "=MID(R13C10,6,2)", "=MID(R13C13,6,2)", _ 
               "=RIGHT(R8C10,10)") 
     With .Range("A14:H35") 
      .FillDown 
      'uncomment the next line after you have examined the formulas 
      '.Value = .Value 
     End With 
     .Range("A12").Delete Shift:=xlUp 
     On Error Resume Next 
     .Columns("I").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
     On Error GoTo 0 
    End With 
End Sub

两个值得关注的领域。首先，我相信你设计了绝对行和列引用的公式，这些引用在填充时没有正确更改。在恢复到他们的计算值之前，您应该查看公式。其次，.Range("A12").Delete Shift:=xlUp似乎不合适，并且该操作似乎没有改进工作表的功能;你应该看看。

来源

2017-06-16 17:22:48 Jeeped

这真的很干净......感谢您的帮助！我修正了行/列引用和错位的范围。非常快速和高效的脚本！ – aksnave

试图让这个vba循环遍历当前工作簿中的所有工作表。它贯穿第一个

回答

相关问题