如何在Excel VBA宏中循环遍历行和列

9

你好,我正在尝试创建一个宏,其中包含一个循环,该循环将函数复制到每个站点的第1列(VOL)和第2列(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

我想要循环下降每个站点的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)

我希望循环执行以下函数,对每个站点的CAPACITY列进行操作:

=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)

请问有人可以帮忙吗?谢谢!

更新

****如何使循环自动运行,而不必手动输入公式到前两个单元格并点击宏?
还有,如何使循环在所有列/行中运行?(水平方向)****

我包含了两个屏幕截图来说明我的意思。以下是我的当前代码。 alt text alt text 谢谢!

    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

@Techgirl09,如果您仍在关注此问题,我知道有一种更简单的方法来解决这个问题。2个问题:公式复制到的范围是否始终相同(即是否可以将其命名为范围)?您希望在工作表激活时触发此操作,还是其他什么时候? - Lance Roberts
6
看起来 Kevin 在你截图的时候给你发送了一封邮件,请确保回复他。 - Alex Gordon
4个回答

6

这是我的建议:

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

谢谢 - 这样复制并粘贴了我的公式到单元格中,但为了这样做,我需要手动将公式输入前两个单元格,然后点击宏。有没有办法使它完全自动化?例如,如果我的工作表完全为空,就像第三个STATION一样,如何使公式自动填充整个表格? - Techgirl09
仅使用此代码,公式将写在公式属性中,而不是复制。您无需在前两个单元格中编写公式。 - Wilhelm

1

这个解决方案与@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

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 到下面 1 行。

只需将其放入 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

谢谢!我搞定了。现在我需要让循环运行,直到我的左侧列(日期范围)为空。我将看看我能如何做到这一点——如果有人能提供输入——将非常感激。 - Techgirl09

0
我建议使用 Range 对象的 AutoFill method 来完成这个任务:
rngSource.AutoFill Destination:=rngDest

指定包含要填充下来的值或公式的源范围,并将目标范围设置为您要将单元格填充到的整个范围。目标范围必须包括源范围。您可以进行横向和纵向填充。

它的工作方式与您使用鼠标手动“拖动”角落的单元格完全相同;绝对和相对公式按预期工作。

以下是一个例子:

'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")

希望这能有所帮助。

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接