我有一张有多张床单的Excel。我在一张纸上创建了一个宏,下面是宏代码。如何编辑此代码以在一次运行中应用于工作簿中的所有工作表。谢谢
子记分表() “ '得分表宏 “
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("F:F").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("H:H").Select
Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Range("I1").Select
ActiveCell.FormulaR1C1 = "3fga "
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Columns("L:L").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("K:K").Select
Selection.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Columns("Y:AB").Select
Selection.Delete Shift:=xlToLeft
Columns("Z:Z").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("Y:Y").Select
Selection.TextToColumns Destination:=Range("Y1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Range("Y1").Select
ActiveCell.FormulaR1C1 = "op_fgm"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("Z1").Select
ActiveCell.FormulaR1C1 = "op_fga "
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Columns("AA:AA").Select
Selection.Delete Shift:=xlToLeft
Columns("AB:AB").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("AA:AA").Select
Selection.TextToColumns Destination:=Range("AA1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Range("AA1").Select
ActiveCell.FormulaR1C1 = "op_3fg"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("AB1").Select
ActiveCell.FormulaR1C1 = "op_3fga "
With ActiveCell.Characters(Start:=1, Length:=8).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Columns("AC:AC").Select
Selection.Delete Shift:=xlToLeft
Columns("AD:AD").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("AC:AC").Select
Selection.TextToColumns Destination:=Range("AC1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Range("AC1").Select
ActiveCell.FormulaR1C1 = "op_ftm"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("AD1").Select
ActiveCell.FormulaR1C1 = "op_fta "
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Columns("AE:AE").Select
Selection.Delete Shift:=xlToLeft
Range("AE1").Select
ActiveCell.FormulaR1C1 = "op_off "
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("AF1").Select
ActiveCell.FormulaR1C1 = "op_def "
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Columns("AG:AH").Select
Selection.Delete Shift:=xlToLeft
Range("AG1").Select
ActiveCell.FormulaR1C1 = "op_pf "
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("AH1").Select
ActiveCell.FormulaR1C1 = "op_ast "
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("AI1").Select
ActiveCell.FormulaR1C1 = "op_to "
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("AJ1").Select
ActiveCell.FormulaR1C1 = "op_blk "
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("AK1").Select
ActiveCell.FormulaR1C1 = "op_stl "
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Columns("AL:AM").Select
Selection.Delete Shift:=xlToLeft
Range("T1").Select
ActiveCell.FormulaR1C1 = "to "
With ActiveCell.Characters(Start:=1, Length:=3).Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 7.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
Range("P1").Activate
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Range("X1").Select
End Sub
答案 0 :(得分:1)
你可以使用这样的东西来遍历你的工作表。例如,此宏只会激活每个工作表并显示一个带有名称的消息框,但您只需复制粘贴要在每个工作表上运行的代码。只是为了重申@Rdster所说的内容,您可能需要花一些时间来更好地组织代码,因为它非常笨重:)
Sub WorksheetLoop()
Dim Count1 As Integer
Dim i As Integer
'Set Count1 equal to the number of worksheets in the active workbook.
Count1 = ActiveWorkbook.Worksheets.Count
For i = 1 To Count1
Worksheets(i).Activate
MsgBox ActiveWorkbook.Worksheets(i).Name
Next
End Sub
答案 1 :(得分:0)
编辑此内容以满足您的需求:
Sub Theloopofloops()
Dim wbk As Workbook
Dim Filename As String
Dim path As String
Dim rCell As Range
Dim rRng As Range
Dim wsO As Worksheet
Dim sheet As Worksheet
path = "pathtofile(s)" & "\"
Filename = Dir(path & "*.xl??")
Set wsO = ThisWorkbook.Sheets("Sheet1") 'included in case you need to differentiate_
between workbooks i.e currently opened workbook vs workbook containing code
Do While Len(Filename) > 0
DoEvents
Set wbk = Workbooks.Open(path & Filename, True, True)
For Each sheet In ActiveWorkbook.Worksheets 'this needs to be adjusted for specifiying sheets. Repeat loop for each sheet so thats on a per sheet basis
Set rRng = sheet.Range("a1:a1000") 'OBV needs to be changed
For Each rCell In rRng.Cells
If rCell <> "" And rCell.Value <> vbNullString And rCell.Value <> 0 Then
'code that does stuff
End If
Next rCell
Next sheet
wbk.Close False
Filename = Dir
Loop
End Sub