For循环更改公式中的特定单元格

我有一个公式,显示特定列中的哪些行符合一组标准。 公式执行并应用于所有行时,我运行一个循环来检查哪些行将某个值作为文本返回,然后将这些单元格复制粘贴到另一个工作表中:

Sub loop1() Dim r As Range, c As Range With Worksheets("Sheet1") Set r = Range(.Range("AF2"), .Range("AF2").End(xlDown)) For Each c In r If WorksheetFunction.IsText(c) Then Range(.Cells(c.Row, "AF"), .Cells(c.Row, "AF")).Copy Else GoTo nextc End If With Worksheets("Sheet2") .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues End With nextc: Next c End With Application.CutCopyMode = False End Sub 

我现在想做的是运行631个不同名称的公式,复制粘贴每个名称作为标题,然后运行loop1。 我不知道如何使公式的循环工作。

 Sub loop2() Dim i As Integer For i = 2 To 632 Sheets("Sheet1").Select Range("AC2").Select ActiveCell.FormulaR1C1 = _ "=IF(RC[-3]=""district1"",(IF(RC[2]=R2C33 ,(IF(RC[-18]>=1,0,(IF(RC[-16]>=1,0,IF(RC[-14]>=1,0,IF(RC[-12]>=1,0,IF(RC[-10]>=1,1,IF(RC[-8]>=1,1,IF(RC[-6]>=1,1,0))))))))),0)),0)" Range("AC2").Select Selection.AutoFill Destination:=Range("AC2:AC20753") Range("AC2:AC20753").Select Range("AG2").Select Selection.Copy Sheets("Sheet2").Select ActiveSheet.Paste Selection.Font.Bold = True Sheets("Sheet1").Select Application.Run "'Customers.xlsb'!loop1" Next i End Sub 

每个循环需要更改的单元格是R2C33,类似于RiC33(不起作用)和“标题”范围(“AG2”),select类似Range(“AGi”)。

任何人可以帮忙吗?

下面的代码将做的伎俩:

 Sub loop2() Dim i As Integer For i = 2 To 632 Sheets("Sheet1").Range("AC2:AC20753").FormulaR1C1 = _ "=IF(RC[-3]=""district1"",(IF(RC[2]=R" & i & "C33 ,(IF(RC[-18]>=1,0,(IF(RC[-16]>=1,0,IF(RC[-14]>=1,0,IF(RC[-12]>=1,0,IF(RC[-10]>=1,1,IF(RC[-8]>=1,1,IF(RC[-6]>=1,1,0))))))))),0)),0)" Sheets("Sheet1").Range("AG" & i).Copy Destination:=Sheets("Sheet2").Range("A1") Sheets("Sheet2").Range("A1").Font.Bold = True Application.Run "'Customers.xlsb'!loop1" Next i End Sub 

为了让i在你的String公式中使用,你必须停止String "使用& i &继续String "

我也改变了你的代码,以防止使用.Select,这在VBA中是不行的。
这样,它会填写您的Formula副本,并更改​​字体,而不select任何内容或更改工作表。

正如吉普所指出的那样,你需要改变Sheets(""Sheet2").Range("A1")因为我不知道你想要粘贴哪个单元格。

你的第一个子程序可能会更好。

 Sub loop1() Dim r As Range, c As Range With Worksheets("Sheet1") Set r = Range(.Range("AF2"), .Range("AF2").End(xlDown)) For Each c In r If WorksheetFunction.IsText(c) Then Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = _ .Cells(c.Row, "AF").Value2 End If Next c End With End Sub 

直接值转移优于复制,粘贴特殊值,值。

在第二个子程序中,您不必做任何事情, R2C33R2C33删除2; 如RC33 。 在xlR1C1公式构造中,一个孤立的R简单地表示公式所在的行,并且您从第2行开始。您也可以将所有公式放在一起。 一旦进入,您可以通过G2:G632单元进行循环播放。

 Sub loop2() Dim i As Integer With Sheets("Sheet1") .Range("AC2:AC20753").FormulaR1C1 = _ "=IF(OR(AND(RC[-3]=""district1"", RC[2]=R2C33, RC[-18]>=1), SUM(RC[-16], RC[-14], RC[-12])>=1), 0, IF(SUM(RC[-10], RC[-8], RC[-6])>=1, 1, 0))" For i = 2 To 632 .Range("AG" & i).Copy _ Destination:=Sheets("Sheet2").Somewhere Sheets("Sheet2").Somewhere.Font.Bold = True Application.Run "'Customers.xlsb'!loop1" Next i Next i End Sub 

我还通过将一些导致零的条件与OR和ANDfunction组合在一起来收紧了你的公式。

剩下的唯一东西就是定义Destination:=Sheets("Sheet2").Somewhere