如何在excel中循環遍歷行VBA宏

Question

嗨，我試圖創建一個循環，它爲每個工作站複製一個函數向下一列（VOL）和另一個函數向下二列（CAPACITY）。這是我到目前爲止有：

Sub TieOut() 
    Dim i As Integer 
    Dim j As Integer 

    For i = 1 To 3 
     For j = 1 To 3 
      Worksheets("TieOut").Cells(i, j).Value = "'=INDEX('ZaiNet Data'!$A$1:$H$39038,MATCH('INDEX-MATCH'!Z$7&TEXT('INDEX-MATCH'!$A9,"m/dd/yyyy"),'ZaiNet Data'!$C$1:$C$39038,0), 4)" 
     Next j 
    Next i 

End Sub 

什麼，我想要的圖片低於：你可以看到，我已經手動複製並粘貼我的兩個功能沿着每列。我只需要一個可以遍歷它的宏。

alt text http://i26.tinypic.com/nz4lfn.jpg

我想對每個站進行循環下來VOL柱的功能是：

=INDEX('ZaiNet Data'!$A$1:$H$39038,MATCH('INDEX-MATCH'!Z$7&TEXT('INDEX-MATCH'!$A438,"M/DD/YYYY"),'ZaiNet Data'!$C$1:$C$39038,0), 4) 

我想要的功能被循環下來每個站的能力列：

=INDEX('ZaiNet Data'!$A$1:$H$39038,MATCH('INDEX-MATCH'!Z$7&TEXT('INDEX-MATCH'!$A438,"M/DD/YYYY"),'ZaiNet Data'!$C$1:$C$39038,0), 5) 

可能有人p租賃幫助？謝謝！

UPDATE

****我怎樣才能自動進行循環運行而無需手動輸入公式到前兩個單元格，然後單擊宏？
另外我怎樣才能讓循環遍歷所有的列/行？ （水平）****

我包括兩個屏幕截圖，以顯示我的意思。以下是我目前的代碼。 alt text http://i26.tinypic.com/i3gw9g.jpg alt text http://i29.tinypic.com/8izl.jpg 謝謝！

Sub Loop3() 
    Selection.Copy 
    ActiveCell.Offset(1, 0).Select 
    ActiveSheet.Paste 
    ActiveCell.Offset(-1, 1).Select 
    Selection.Copy 
    ActiveCell.Offset(1, 0).Select 
    ActiveSheet.Paste 
    ActiveCell.Offset(0, -1).Select 

    Dim i As Integer 
    Dim j As Integer 
     With Worksheets("Loop") 
      i = 1 
      Do Until .Cells(10, i).Value = "blank" 
       For j = 1 To 10 
        .Cells(j, i).Formula = "=INDEX('ZAINET DATA'!$A$1:$H$39038,MATCH(Loop!E$7&TEXT(Loop!$A9,""M/D/YYYY""),'ZAINET DATA'!$C$1:$C$39038,0),4)" 
        .Cells(j, i + 1).Formula = "=INDEX('ZAINET DATA'!$A$1:$H$39038,MATCH(Loop!E$7&TEXT(Loop!$A9,""M/D/YYYY""),'ZAINET DATA'!$C$1:$C$39038,0),5)" 
       Next j 
       i = i + 2 
      Loop 
    End With 

    Selection.Copy 
    ActiveCell.Offset(1, 0).Select 
    ActiveSheet.Paste 
    ActiveCell.Offset(-1, 1).Select 
    Selection.Copy 
    ActiveCell.Offset(1, 0).Select 
    ActiveSheet.Paste 
    ActiveCell.Offset(0, -1).Select 

End Sub 

Answer 1

試試這個：

與下列的東西里面創建宏：

Selection.Copy 
ActiveCell.Offset(1, 0).Select 
ActiveSheet.Paste 
ActiveCell.Offset(-1, 1).Select 
Selection.Copy 
ActiveCell.Offset(1, 0).Select 
ActiveSheet.Paste 
ActiveCell.Offset(0, -1).Select 

這個特定的宏將複製當前單元格（請將光標在VOL細胞要複製）向下一行，然後複製CAP單元。

這只是一個單一的循環，因此您可以自動將當前活動單元（光標所在的位置）的VOL和CAP複製到下一行。

只要把它放在For循環語句中就可以做x次。 喜歡：

For i = 1 to 100 'Do this 100 times 
    Selection.Copy 
    ActiveCell.Offset(1, 0).Select 
    ActiveSheet.Paste 
    ActiveCell.Offset(-1, 1).Select 
    Selection.Copy 
    ActiveCell.Offset(1, 0).Select 
    ActiveSheet.Paste 
    ActiveCell.Offset(0, -1).Select 
Next i 

Answer 2

這裏是我的sugestion：

Dim i As integer, j as integer 

With Worksheets("TimeOut") 
    i = 26 
    Do Until .Cells(8, i).Value = "" 
     For j = 9 to 100 ' I do not know how many rows you will need it.' 
      .Cells(j, i).Formula = "YourVolFormulaHere" 
      .Cells(j, i + 1).Formula = "YourCapFormulaHere" 
     Next j 

     i = i + 2 
    Loop 
End With 

Answer 3

我建議Range對象的AutoFillmethod此：

rngSource.AutoFill Destination:=rngDest 

指定包含值的來源範圍或要填充的公式以及目標範圍作爲您希望單元填充的整個範圍。目標範圍必須包含源範圍。您可以填寫以及填寫。

它的工作方式與使用鼠標手動「拖動」拐角處單元格的方式完全相同， absolute and relative formulas按預期工作。

下面是一個例子：

'Set some example values' 
Range("A1").Value = "1" 
Range("B1").Formula = "=NOW()" 
Range("C1").Formula = "=B1+A1" 

'AutoFill the values/formulas to row 20' 
Range("A1:C1").AutoFill Destination:=Range("A1:C20") 

希望這有助於。

Answer 4

這與@ Wilhelm的解決方案類似。循環根據通過評估填充日期列創建的範圍自動化。這嚴格依據這裏的對話和截圖進行打包。

請注意：這假設標題將始終在同一行（第8行）。更改第一行數據（向上/向下移動標題）將導致範圍自動化中斷，除非您編輯範圍塊以動態獲取標題行。其他假設包括VOL和CAPACITY公式列標題分別命名爲「Vol」和「Cap」。

Sub Loop3() 

Dim dtCnt As Long 
Dim rng As Range 
Dim frmlas() As String 

Application.ScreenUpdating = False 

'The following code block sets up the formula output range 
dtCnt = Sheets("Loop").Range("A1048576").End(xlUp).Row    'lowest date column populated 
endHead = Sheets("Loop").Range("XFD8").End(xlToLeft).Column   'right most header populated 
Set rng = Sheets("Loop").Range(Cells(9, 2), Cells(dtCnt, endHead)) 'assigns range for automation 

ReDim frmlas(1)  'array assigned to formula strings 
    'VOL column formula 
frmlas(0) = "VOL FORMULA" 
    'CAPACITY column formula 
frmlas(1) = "CAP FORMULA" 

For i = 1 To rng.Columns.count 
If rng(0, i).Value = "Vol" Then   'checks for volume formula column 
    For j = 1 To rng.Rows.count 
     rng(j, i).Formula= frmlas(0) 'inserts volume formula 
    Next j 
ElseIf rng(0, i).Value = "Cap" Then  'checks for capacity formula column 
    For j = 1 To rng.Rows.count 
     rng(j, i).Formula = frmlas(1) 'inserts capacity formula 
    Next j 
End If 
Next i 

Application.ScreenUpdating = True 

End Sub