试图让这个 vba 循环遍历当前工作簿中的所有工作表。它贯穿第一
Trying to get this vba to loop through all worksheets in the current workbook. It runs through the first
此循环 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
这里是在没有 .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
似乎不合适,并且该操作似乎没有做一些改进工作表的事情;你应该调查一下。
此循环 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
这里是在没有 .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
似乎不合适,并且该操作似乎没有做一些改进工作表的事情;你应该调查一下。