如何用VBA脚本将Sheet2列P的唯一名称间隔20行复制到Sheet1？

Alright, I’ve put together a VBA script that does exactly what you need—pulls unique names from Sheet2's column P, pastes them into Sheet1 with a 20-row gap between each entry, and adds a SUMIFS formula right below each name to link back to Sheet2 for analysis.

Full VBA Code #

Sub PasteUniqueNamesWithFormulas()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow As Long
    Dim uniqueNames As Object ' Late-binding for Dictionary (no extra reference needed)
    Dim cell As Range
    Dim currentRow As Long
    
    ' Set worksheet references (adjust sheet names if yours are different)
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set uniqueNames = CreateObject("Scripting.Dictionary")
    
    ' Find the last row with data in Sheet2's column P
    lastRow = ws2.Cells(ws2.Rows.Count, "P").End(xlUp).Row
    
    ' Collect unique names from Sheet2 column P (skip blanks and duplicates)
    For Each cell In ws2.Range("P2:P" & lastRow) ' Start at P2 if P1 is a header row
        If cell.Value <> "" And Not uniqueNames.Exists(cell.Value) Then
            uniqueNames.Add cell.Value, True
        End If
    Next cell
    
    ' Start pasting names at row 2 in Sheet1 (adjust if your header is in a different row)
    currentRow = 2
    
    ' Loop through each unique name to paste and add the formula
    For Each nameKey In uniqueNames.Keys
        ' Paste the unique name into Sheet1
        ws1.Cells(currentRow, "A").Value = nameKey ' Change "A" to your target column if needed
        
        ' Add the SUMIFS formula directly below the name
        ' Modify $Q:$Q to match the column you want to sum in Sheet2
        ws1.Cells(currentRow + 1, "A").Formula = _
            "=SUMIFS(Sheet2!$Q:$Q, Sheet2!$P:$P, A" & currentRow & ")"
        
        ' Jump 21 rows ahead to create a 20-row gap between entries
        currentRow = currentRow + 21 ' +21 accounts for the name + formula rows plus 20 blank rows
    Next nameKey
    
    ' Optional: Auto-fit the column in Sheet1 for better readability
    ws1.Columns("A").AutoFit
    
    MsgBox "Task completed successfully!", vbInformation
End Sub

How It Works (And How to Tweak It) #

Let me break down the key parts so you can adjust it to your exact setup:

• Unique Name Collection: Uses a Scripting.Dictionary to automatically ignore duplicates from Sheet2's column P. Late-binding means you don’t need to enable any special references in the VBA editor.
• Pasting & Formula Link: Starts pasting names at row 2 in Sheet1—change currentRow = 2 if your Sheet1 has a different starting point. The SUMIFS formula is tied directly to the name above it; just update Sheet2!$Q:$Q to match the column you want to analyze.
• 20-Row Gap: After placing a name and its formula, we jump 21 rows forward. This leaves exactly 20 blank rows between the end of one entry (formula row) and the start of the next name.

Quick Adjustments You Might Need #

• If you want names in a different column in Sheet1, replace "A" in ws1.Cells(currentRow, "A") with your target column (e.g., "B" or "C").
• If Sheet2’s data starts at row 1 (no header), adjust the loop to ws2.Range("P1:P" & lastRow).
• To add more criteria to the SUMIFS formula, just append additional range/criteria pairs inside the formula (e.g., , Sheet2!$R:$R, "Completed").

内容的提问来源于stack exchange，提问作者batt700