VBA - 根据另一个选项卡上的数据将公式向下发送到最后一行数据

Question

我试图找出一种方法，根据第二个选项卡上的单元格数量将公式向下发送到最后一行数据，这些单元格具有捕获除标题之外的所有值的数据。

我的公式在单元格 A4:V4 的 Sheet1 上。 Sheet1 上的第 1:3 行有标题。 我要引用的单元格数量在 Sheet2 上。 Sheet2 上有 88 个单元格包含数据，包括第 1 行的标题，因此有 87 个唯一值。 我目前这样做的方式只是将我在 Sheet1 上的公式发送到第 88 行。我不希望计数包含 Sheet2 第 1 行的标题。

看起来是因为 Sheet2 上有 88 个值，这是我在 Sheet1 上获得的总行数，包括我的 3 行标题，所以有 85 个唯一值。 总的来说，我应该在 Sheet1 上看到总共 90 行（包括现有标题），但不知道该怎么做。 这是我的公式：

Sub AmendRows()

Dim LastRow As String

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Locktabs False

worksheet1.Select
LastRow = worksheet1.Range("A5").EntireRow.Select
rows(ActiveCell.row & ":" & rows.count).ClearContents
rows(ActiveCell.row & ":" & rows.count).ClearFormats

worksheet1.Range("A4:V4").AutoFill Destination:=worksheet1("A4:V" & worksheet2.range("A" & rows.count).end(xlUp).row)

Locktabs True

worksheetmain.Select
MsgBox "Rows Amended!"


End Sub

谢谢

Answer 1

Sub AmendRows()

    Dim worksheet1 As Worksheet, worksheet2 As Worksheet
    Dim n As Long, rng As Range
    
    Set worksheet1 = Sheet1 ' as appropriate
    Set worksheet2 = Sheet2 ' as appropriate
    
    n = worksheet2.UsedRange.Rows.Count - 1 ' no header
    If n < 1 Then Exit Sub
   
    With worksheet1

        With .Rows("5:" & .Rows.Count)
            .ClearContents
            .ClearFormats
        End With
        
        Set rng = .Range("A4:V4")
        rng.AutoFill Destination:=rng.Resize(n)
        
    End With
    MsgBox n & " Rows Amended! " & rng.Resize(n).Address

End Sub

Answer 2

向下复制公式

Option Explicit

Sub AmendRows()

    Const DST_FIRST_ROW As String = "A4:V4"
    Const SRC_FIRST_CELL As String = "A2"

    Application.ScreenUpdating = False
    'Application.DisplayAlerts = False ' ?
    
    Locktabs False
    
    Dim srCount As Long

    With worksheet2.Range(SRC_FIRST_CELL)
        Dim slCell As Range: Set slCell = .Resize(.Worksheet.Rows.Count - .Row _
            + 1).Find("*", , xlFormulas, , , xlPrevious)
        If Not slCell Is Nothing Then srCount = slCell.Row - .Row + 1
    End With
    
    With worksheet1.Range(DST_FIRST_ROW)
        With .Offset(1).Resize(.Worksheet.Rows.Count - .Row)
            .ClearContents
            .ClearFormats
        End With
        If srCount > 0 Then .Copy .Resize(srCount)
    End With
    
    Locktabs True
    
    If Not worksheetmain Is ActiveSheet Then
        With worksheetmain
            If Not .Parent Is ActiveWorkbook Then .Parent.Activate
            .Select
        End With
    End If

    'Application.DisplayAlerts = True ' ?
    Application.ScreenUpdating = True
    
    MsgBox "Rows Amended!", vbInformation

End Sub