1. 首頁
  2. 問答
  3. excel宏適用於所有紙張

excel宏適用於所有紙張

2016-11-30 62 views
-2

我有一個excel與多張紙。我用下面的宏代碼在一張紙上創建了一個宏。如何編輯此代碼以在一次運行中應用於工作簿中的所有工作表上。謝謝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

末次

來源

2016-11-30 Tarek Khedr

+2

您需要通過在VBA工作表Google圈圈。 –

+0

你能告訴我那是怎麼回事？我不是開發者。謝謝 –

+2

哇，那個錄音機代碼是詳細的...清理它一些http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros – Rdster

回答

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

來源

2016-11-30 14:39:36

+0

謝謝，我會試試這個 –

+0

激活工作表是不必要的，馬虎。如果有幾噸牀單呢？你想讓他的腳本永遠運行？大聲笑 –

+1

哈哈我只是把它作爲一個例子來工作。包括你會的;） – 2016-11-30 14:49:00

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

來源

2016-11-30 14:39:35

相關問題

 相關問題