在不同的單元上運行一個宏

-1

我想運行像D2這樣的單元上的宏....將D2作爲活動單元.. 我可以一次運行所有單元上的宏以獲得結果..下面的代碼我只能在一個單元運行宏在不同的單元上運行一個宏

Sub Allocation() 

' 
' Allocation Macro 
' 
' Keyboard Shortcut: Ctrl+g 
' 
    Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ 
     Semicolon:=True, Comma:=True, Space:=True, Other:=True, FieldInfo:= _ 
     Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _ 
     TrailingMinusNumbers:=True 
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    ActiveCell.Offset(-1, 4).Range("A1").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Selection.Copy 
    ActiveCell.Offset(1, -1).Range("A1").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveCell.Offset(-1, -3).Range("A1:C1").Select 
    Application.CutCopyMode = False 
    Selection.AutoFill Destination:=ActiveCell.Range("A1:C16"), Type:= _ 
     xlFillDefault 
    ActiveCell.Range("A1:C16").Select 
    ActiveCell.Offset(0, 4).Range("A1").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Selection.ClearContents 
End Sub

來源

2013-09-25 user2800680

此問題與您在9月20日提出的問題幾乎相同：[在多個單元格上運行單個宏]（http：// stac koverflow.com/questions/18925855/running-a-single-macro-on-several-cells） –

這不是100％清楚地知道你在做什麼之後，而是通過在一開始選擇的單元格區域這將循環：

Sub Allocation() 

' 
' Allocation Macro 
' 
' Keyboard Shortcut: Ctrl+g 
' 
Dim r As Range, c 
Set r = Selection 
For c = 1 To r.Count 
    r(c).Select 
     Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ 
     Semicolon:=True, Comma:=True, Space:=True, Other:=True, FieldInfo:= _ 
     Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _ 
     TrailingMinusNumbers:=True 
     ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     ActiveCell.Offset(-1, 4).Range("A1").Select 
     Range(Selection, Selection.End(xlToRight)).Select 
     Selection.Copy 
     ActiveCell.Offset(1, -1).Range("A1").Select 
     Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
      False, Transpose:=True 
     ActiveCell.Offset(-1, -3).Range("A1:C1").Select 
     Application.CutCopyMode = False 
     Selection.AutoFill Destination:=ActiveCell.Range("A1:C16"), Type:= _ 
      xlFillDefault 
     ActiveCell.Range("A1:C16").Select 
     ActiveCell.Offset(0, 4).Range("A1").Select 
     Range(Selection, Selection.End(xlToRight)).Select 
     Selection.ClearContents 
Next 
End Sub

來源

2013-09-25 13:41:02

在不同的單元上運行一個宏

回答

相關問題