如何获取目标单元格上方单元格的值？Excel VBA多表筛选汇总求助

Hey there! Let's work through this VBA task to get your parcel data (and related info) summed up in the "Test" sheet.

First, let's recap your data structure to make sure we're on the same page: each data block is 1 column × 4 rows, ordered like this:

• Row 1 of the block: Owner
• Row 2 of the block: Area
• Row 3 of the block: Parcel (always starts with "D")
• Row 4 of the block: Transaction Year

Since you already can locate the Parcel cell, getting the owner/area values is straightforward using the Offset method—it lets you grab cells relative to your target cell. Here's a full, commented solution that ties everything together:

Sub Zoek_kavels()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range ' Add this to iterate through each cell in UsedRange
    Dim ownerVal As Variant, areaVal As Variant, yearVal As Variant
    Dim rij As Long ' Use Long instead of Integer to avoid row count overflow
    
    ' Initialize row counter and set up headers in "Test" sheet
    rij = 1
    With Sheets("Test")
        .Cells.Clear ' Optional: Clear existing data before new run
        .Cells(rij, 1).Value = "Owner"
        .Cells(rij, 2).Value = "Area"
        .Cells(rij, 3).Value = "Parcel"
        .Cells(rij, 4).Value = "Transaction Year"
        .Cells(rij, 5).Value = "Source Worksheet" ' Helpful for tracing data
    End With
    rij = rij + 1 ' Move to first data row
    
    ' Loop through every worksheet in the workbook
    For Each ws In ActiveWorkbook.Sheets
        ' Skip the "Test" sheet itself to avoid processing summary data
        If ws.Name <> "Test" Then
            Set rng = ws.UsedRange
            ' Iterate through each cell in the used range
            For Each cell In rng
                ' Check if cell starts with "D" (Parcel value) AND it's part of a valid 4-row block
                ' Make sure there are 2 rows above and 1 row below to avoid out-of-bounds errors
                If Not IsEmpty(cell.Value) And Left(CStr(cell.Value), 1) = "D" _
                    And cell.Row >= 3 And cell.Row + 1 <= ws.UsedRange.Rows.Count Then
                    
                    ' Pull values from relative positions
                    ownerVal = cell.Offset(-2, 0).Value ' 2 rows above = Owner
                    areaVal = cell.Offset(-1, 0).Value ' 1 row above = Area
                    yearVal = cell.Offset(1, 0).Value ' 1 row below = Transaction Year
                    
                    ' Write data to "Test" sheet
                    With Sheets("Test")
                        .Cells(rij, 1).Value = ownerVal
                        .Cells(rij, 2).Value = areaVal
                        .Cells(rij, 3).Value = cell.Value
                        .Cells(rij, 4).Value = yearVal
                        .Cells(rij, 5).Value = ws.Name
                    End With
                    
                    rij = rij + 1 ' Move to next row for next entry
                End If
            Next cell
        End If
    Next ws
    
    ' Optional: Auto-fit columns in "Test" sheet for readability
    Sheets("Test").Columns.AutoFit
    
    MsgBox "Summary completed! Check the 'Test' sheet.", vbInformation
End Sub

Key Details Explained: #

• Offset Method: This is the core of grabbing the owner/area data. cell.Offset(-2, 0) means "the cell 2 rows above the current cell, same column"—perfect for the Owner value. Similarly, Offset(-1,0) gets the Area value, and Offset(1,0) gets the Transaction Year.
• Skipping the Test Sheet: We add a check to avoid looping through the summary sheet itself, which prevents duplicate or incorrect data.
• Valid Block Check: The cell.Row >=3 and cell.Row +1 <= ... ensures we only process cells that are part of a complete 4-row block (no partial blocks at the top/bottom of a sheet).
• Data Tracing: Adding the "Source Worksheet" column helps you track where each entry came from, which is super useful for debugging or verifying data.

If you run into any edge cases (like empty cells in blocks or non-text parcel values), you can tweak the validation checks to fit your specific workbook.

内容的提问来源于stack exchange，提问作者C.W.A. Baltus