VBA实现：按房产类别提取对应最大年份关联数值

Hey Carlos, let's tackle this problem step by step. I've worked through similar scenarios before, so here's a solid VBA solution that'll group your properties, find the latest year for each, and pull the corresponding values—even handling edge cases like duplicate years or blank values.

核心思路 #

Before diving into code, let's break down the logic to make it clear:

• First, sort your data by the "房产" column so all entries for the same property are grouped together. This makes it easy to process one category at a time without jumping around.
• Track the current property category, its maximum year, and the corresponding value as we loop through each row.
• When we hit a new property category, we'll write the previous category's result to the output sheet, then reset our tracking variables for the new group.
• Handle messy values (like commas in numbers or "-" for blanks) with a helper function to ensure clean results.

Full VBA Code #

Here's the complete, commented code you can drop into your Excel workbook:

Sub ExtractMaxYearValues()
    Dim wsSource As Worksheet, wsResult As Worksheet
    Dim lastRow As Long, i As Long, resultRow As Long
    Dim currentProp As String, maxYear As Integer
    Dim currentValue As Variant
    
    ' Set source and result worksheets (update names if yours are different)
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    On Error Resume Next
    Set wsResult = ThisWorkbook.Worksheets("Result")
    On Error GoTo 0
    If wsResult Is Nothing Then
        Set wsResult = ThisWorkbook.Worksheets.Add
        wsResult.Name = "Result"
    End If
    
    ' Write result headers
    wsResult.Range("A1:C1") = Array("房产", "最大年份", "关联数值")
    resultRow = 2
    
    ' Get last row of source data
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' Sort data by property to group same categories together
    wsSource.Sort.SortFields.Clear
    wsSource.Sort.SortFields.Add Key:=wsSource.Range("A2:A" & lastRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wsSource.Sort
        .SetRange wsSource.Range("A1:C" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' Initialize tracking variables with first data row
    currentProp = wsSource.Range("A2").Value
    maxYear = wsSource.Range("B2").Value
    currentValue = ProcessValue(wsSource.Range("C2").Value)
    
    ' Loop through remaining rows
    For i = 3 To lastRow
        ' Same property category: update max year and value if needed
        If wsSource.Range("A" & i).Value = currentProp Then
            If wsSource.Range("B" & i).Value > maxYear Then
                maxYear = wsSource.Range("B" & i).Value
                currentValue = ProcessValue(wsSource.Range("C" & i).Value)
            ' Handle duplicate max years: this takes the last entry, adjust if needed
            ElseIf wsSource.Range("B" & i).Value = maxYear Then
                currentValue = ProcessValue(wsSource.Range("C" & i).Value)
            End If
        Else
            ' New property category: write previous result to output
            wsResult.Range("A" & resultRow).Value = currentProp
            wsResult.Range("B" & resultRow).Value = maxYear
            wsResult.Range("C" & resultRow).Value = currentValue
            
            ' Reset tracking variables for new category
            currentProp = wsSource.Range("A" & i).Value
            maxYear = wsSource.Range("B" & i).Value
            currentValue = ProcessValue(wsSource.Range("C" & i).Value)
            
            ' Move to next row in result sheet
            resultRow = resultRow + 1
        End If
    Next i
    
    ' Write the last property category's result
    wsResult.Range("A" & resultRow).Value = currentProp
    wsResult.Range("B" & resultRow).Value = maxYear
    wsResult.Range("C" & resultRow).Value = currentValue
    
    ' Format the value column for readability (optional)
    wsResult.Columns("C:C").NumberFormat = "#,##0"
    MsgBox "Processing complete! Results saved to the 'Result' worksheet.", vbInformation
End Sub

' Helper function to clean and convert values (handles commas and blanks)
Function ProcessValue(rawValue As Variant) As Variant
    Dim cleanedValue As String
    
    ' Handle blank or "-" values
    If IsEmpty(rawValue) Or rawValue = "-" Then
        ProcessValue = Empty ' Change to 0 if you prefer numeric blanks
        Exit Function
    End If
    
    ' Remove commas from numbers
    cleanedValue = Replace(rawValue, ",", "")
    ' Convert to numeric if possible
    If IsNumeric(cleanedValue) Then
        ProcessValue = CDbl(cleanedValue)
    Else
        ProcessValue = rawValue ' Keep original if conversion fails
    End If
End Function

Key Details to Note #

1. Sorting is critical: The code sorts your source data first so all entries for the same property are consecutive. This eliminates the need to search the entire sheet for each category, making the loop efficient.
2. Duplicate max years: Right now, the code takes the last value if multiple rows share the same max year. If you want to sum them or take the first one, just modify the ElseIf wsSource.Range("B" & i).Value = maxYear block.
3. Value cleaning: The ProcessValue helper function handles commas in numeric values and replaces "-" blanks with empty (or 0, if you change that line). This ensures your output is usable for further calculations.
4. Result sheet: The code creates a new "Result" sheet if it doesn't exist, so you don't have to set it up manually.

How to Use #

1. Open your Excel workbook with the data.
2. Press Alt + F11 to open the VBA editor.
3. Insert a new module (Right-click your workbook in the Project pane > Insert > Module).
4. Paste the code above into the module.
5. Update the wsSource line if your data is on a sheet with a different name (e.g., Set wsSource = ThisWorkbook.Worksheets("Data")).
6. Run the macro (Press F5 while in the code, or use the Macro dialog in Excel).

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