插入带动态行的公式

时间:2016-03-14 14:11:23

标签: vba excel-vba excel

我有一个寻找"日期的公式:" A列中的值并在相邻的B单元格中粘贴公式,但我无法弄清楚如何使公式动态化。

因此,如果我在A6和A8中有一个值 - 我希望插入的公式具有相同的行号T6和T8。现在它每次都使用相同的行号。



Sub Check()
Dim rng As Range
Dim i As Long
  

Set rng = Range("A8:A48")
   
For Each cell In rng
    'test if cell is empty
    If cell.Value = "Date:" Then
        'write to adjacent cell

        cell.Offset(0, 1).Formula = "=TEXT(T8,""mmm-dd-yyyy"")&"" | ""&V8&"" - ""&U8&"" | Dept: ""&W8"
       
    End If
Next
End Sub




3 个答案:

答案 0 :(得分:2)

您可以阅读.Row对象的cell属性,并在公式中使用该属性。

像这样:

Sub Check()
    Dim rng As Range
    Dim i As Long
    Dim lRow As Long

    Set rng = Range("A8:A48")

    For Each cell In rng
        'test if cell is empty
        If cell.Value = "Date:" Then
            'write to adjacent cell

            lRow = cell.Row 'Get the current row

            'Use the lRow variable in the formula to create the formula dynamically
            cell.Offset(0, 1).Formula = "=TEXT(T" & lRow & ",""mmm-dd-yyyy"")&"" | ""&V" & lRow & "&"" - ""&U" & lRow & "&"" | Dept: ""&W" & lRow & ""

        End If
    Next
End Sub

我相信公式设置正确。快速测试表明它输出了一个有效的公式。如果有任何需要调整,请告诉我。

答案 1 :(得分:1)

为行值设置一个变量,并将其转换为公式插入的字符串,如此

Sub Check()
    Dim i As Integer
    Dim j As String

    'for each row 
    For i = 8 To 48
        If Cells(i, 1).Value = "Date:" Then
            'set the string for use in the formula
            j = Trim(Str(i))
            Cells(i, 2).Formula = "=TEXT(T8,""mmm-dd-yyyy"")& "" | "" &V" & j & "& "" - "" &U" & j & "&"" | Dept: ""&W" & j & ""
       End If
    Next
End Sub

如果您的范围确实有限,那么您最好直接在工作表中设置条件公式,如下所示:

=IF(A8="Date:",TEXT(T8,"mmm-dd-yyyy") & " | " & V8 & " - " & U8 & " | Dept: " & W8,"")

这只会在A8 = Date:的情况下显示文字。向下拖动公式将增加行号

答案 2 :(得分:0)

使用R1C1格式:

Sub Check()
    Dim rng As Range
    Dim i As Long
    Dim cell As Range 'Remember to declare cell as a range.

    'Qualify your ranges with at least the sheet name.
    Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A8:A48")

    For Each cell In rng
        'test if cell is empty
        If cell.Value = "Date:" Then
            'write to adjacent cell

            'cell.Offset(0, 1).Formula = "=TEXT(T8,""mmm-dd-yyyy"")&"" | ""&V8&"" - ""&U8&"" | Dept: ""&W8"
            cell.Offset(0, 1).FormulaR1C1 = "=TEXT(RC20,""mmm-dd-yyyy"")&"" | ""&RC22&"" - ""&RC21&"" | Dept: ""&RC23"

        End If
    Next
End Sub

RC20表示第20行。R1C20表示第1行,第20行。RC[-1]表示此行,左侧是一列。
http://www.numeritas.co.uk/2013/09/the-%E2%80%98dark-art%E2%80%99-of-r1c1-notation/