用宏自动填充公式

编程语言 2026-07-09

我想让这个宏自动把公式填充到T2和 U2向下。问题在于行数总在变化，所以把结束设在T70和 U70的静态方式不起作用。有没有办法根据有数据的行数向下填充？

PenaltyNew Macro
'
' Keyboard Shortcut: Ctrl+Shift+P
'
    Range("T2").Select
    ActiveCell.Formula2R1C1 = _
        "=LOOKUP(2,1/(R2C[-19]:RC[-19]<>""""),ROW(R2C[-19]:RC[-19]))"
    Range("T2").Select
    Selection.AutoFill Destination:=Range("T2:T70"), Type:=xlFillDefault
    Range("T2:T70").Select
    Range("U2").Select
    ActiveCell.Formula2R1C1 = _
        "=AND(ISNUMBER(SEARCH(""MISSED BREAK"",UPPER(TRIM(INDEX(C3,RC20))))),OR(UPPER(TRIM(RC18))=""MISSED"",RC18=0))"
    Range("U2").Select
    Selection.AutoFill Destination:=Range("U2:U70"), Type:=xlFillDefault
    Range("U2:U70").Select
    Sheets("TimeEntries_2026_04_15-2026_04_").Select
    Sheets("TimeEntries_2026_04_15-2026_04_").Name = "Sheet1"
    Sheets.Add After:=ActiveSheet
    ActiveCell.Formula2R1C1 = _
        "=VSTACK(Sheet1!RC:RC[18],LET(hdr,Sheet1!R[1]C[19]:R[999]C[19],keep,Sheet1!R[1]C[20]:R[999]C[20],rowsAbs,FILTER(ROW(hdr),keep),hdrAbs,INDEX(hdr,rowsAbs-ROW(Sheet1!R2C[19])+1),hdrRel,hdrAbs-ROW(Sheet1!R2C)+1,rowsRel,rowsAbs-ROW(Sheet1!R2C[14])+1,CHOOSE({1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19}, INDEX(Sheet1!R2C:R1000C,hdrRel), INDEX(Sheet1!R2C[1]:R1000C[1],hdr" & _
        "Rel), INDEX(Sheet1!R2C[2]:R1000C[2],hdrRel), INDEX(Sheet1!R2C[3]:R1000C[3],hdrRel), INDEX(Sheet1!R2C[4]:R1000C[4],hdrRel), IFERROR(VALUE(INDEX(Sheet1!R2C[5]:R1000C[5],hdrRel)),INDEX(Sheet1!R2C[5]:R1000C[5],hdrRel))," & Chr(10) & "IFERROR(VALUE(INDEX(Sheet1!R2C[6]:R1000C[6],hdrRel)),INDEX(Sheet1!R2C[6]:R1000C[6],hdrRel)), IFERROR(VALUE(INDEX(Sheet1!R2C[7]:R1000C[7],hdrRel)),INDEX(" & _
        "Sheet1!R2C[7]:R1000C[7],hdrRel)), INDEX(Sheet1!R2C[8]:R1000C[8],hdrRel), INDEX(Sheet1!R2C[9]:R1000C[9],hdrRel), INDEX(Sheet1!R2C[10]:R1000C[10],hdrRel), INDEX(Sheet1!R2C[11]:R1000C[11],hdrRel), INDEX(Sheet1!R2C[12]:R1000C[12],hdrRel), INDEX(Sheet1!R2C[13]:R1000C[13],hdrRel), INDEX(Sheet1!R2C[14]:R1000C[14],rowsRel), IF(LEN(TRIM(INDEX(Sheet1!R2C[15]:R1000C[15],rowsRe" & _
        "l)))=0,"""",IFERROR(VALUE(INDEX(Sheet1!R2C[15]:R1000C[15],rowsRel)),INDEX(Sheet1!R2C[15]:R1000C[15],rowsRel))), IF(LEN(TRIM(INDEX(Sheet1!R2C[16]:R1000C[16],rowsRel)))=0,"""",IFERROR(VALUE(INDEX(Sheet1!R2C[16]:R1000C[16],rowsRel)),INDEX(Sheet1!R2C[16]:R1000C[16],rowsRel))), INDEX(Sheet1!R2C[17]:R1000C[17],rowsRel), INDEX(Sheet1!R2C[18]:R1000C[18],rowsRel))))" & _
        ""
    Range("A2").Select
End Sub

解决方案

如果 "TimeEntries_2026_04_15-2026_04_" 就是你放置公式的地方：

Sub PenaltyNew()

    Dim ws As Worksheet, lastRow As Long

    Set ws = ActiveSheet 'or some other specific sheet
    'find the last row:choose a column which always has data
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ws.Range("T2:T" & lastRow).Formula2R1C1 = _
                    "=LOOKUP(2,1/(R2C[-19]:RC[-19]<>""""),ROW(R2C[-19]:RC[-19]))"

    ws.Range("U2:U" & lastRow).Formula2R1C1 = _
                    "=AND(ISNUMBER(SEARCH(""MISSED BREAK"",UPPER(TRIM(INDEX(C3,RC20)))))," & _
                          "OR(UPPER(TRIM(RC18))=""MISSED"",RC18=0))"

    ws.Name = "Sheet1"                'rename the sheet
    Set ws = Sheets.Add(After:=ws)    'add new sheet and get a reference to it
    ws.Range("A1").Formula2R1C1 = "=[your very long formula here]"
    ws.Select

End Sub

Excel