Question

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

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。我无法弄清楚如何使for循环工作在公式内。

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”）。选择像Range（“AGi”）这样的东西。选择。

任何可以提供帮助的人？

Answer 1

以下代码可以解决问题：

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副本并更改字体，而无需选择任何内容或更改工作表。

正如Jeep所说，你需要更改Sheets(""Sheet2").Range("A1")，因为我不知道你要粘贴哪个单元格。

Answer 2

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

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

直接值传输优先于复制，选择性粘贴，值。

在第二个子程序中，除了从R2C33删除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和AND函数一起导致零的条件分组来收紧你的公式。

唯一剩下的就是定义我悬挂的Destination:=Sheets("Sheet2").Somewhere。

for循环更改公式

2 个答案: