嗨,我正在尝试创建一个具有循环的宏,该循环将功能向下复制到第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
我想要的图片如下:您可以看到我已经在每列中手动复制并粘贴了我的两个功能。我只需要一个可以遍历它的宏。
我希望在每个电台的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)
有人可以帮忙吗?谢谢!
更新
****如何自动运行循环而无需手动将公式输入前两个单元格并单击宏?
另外,我如何让循环遍历所有列/行? (horizontically)****
我包括两个屏幕截图来显示我的意思。以下是我目前的代码。 谢谢!
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
答案 0 :(得分: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
答案 1 :(得分: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
答案 2 :(得分: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
答案 3 :(得分:0)
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")
希望这有帮助。