将Excel特定数据运算与比对逻辑转换为VBA代码（含数组应用）

Hey there! I’ve put together a VBA solution that checks all your boxes—segmenting data by 10-year periods, using arrays for fast processing, and handling the value comparison between your worksheets. Here’s the breakdown:

Full VBA Code #

Sub Compare10YearPeriods()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim period As Integer
    Dim maxPeriods As Integer ' Adjust this to your total number of 10-year periods
    Dim hRange As Range
    Dim hArray As Variant, ws2CArray As Variant
    Dim c10Value As Double
    Dim i As Long, j As Long
    Dim matchFound As Boolean
    
    ' Set worksheet references (update names if yours differ)
    Set ws1 = ThisWorkbook.Worksheets("Worksheet1")
    Set ws2 = ThisWorkbook.Worksheets("Worksheet2")
    
    ' Grab the fixed value from Worksheet1's C10
    c10Value = ws1.Range("C10").Value
    
    ' Load Worksheet2's entire C column into an array (trim to a smaller range if needed)
    ws2CArray = ws2.Range("C:C").Value
    
    ' Define how many 10-year periods you need to process
    maxPeriods = 5 ' Example: processes up to 50 years (5 decades)
    
    ' Loop through each 10-year period
    For period = 1 To maxPeriods
        ' Calculate the H column range for this period: starts at H20, extends 10 rows per period
        Set hRange = ws1.Range("H20:H" & (20 + 10 * period))
        
        ' Load the range into an array for efficient processing
        hArray = hRange.Value
        
        ' Process each value in the current period's array
        For i = LBound(hArray, 1) To UBound(hArray, 1)
            ' Skip empty cells to avoid errors
            If Not IsEmpty(hArray(i, 1)) Then
                ' Compute the new value: H column value + C10
                Dim newValue As Double
                newValue = hArray(i, 1) + c10Value
                
                ' Check if the new value exists in Worksheet2's C column
                matchFound = False
                For j = LBound(ws2CArray, 1) To UBound(ws2CArray, 1)
                    If Not IsEmpty(ws2CArray(j, 1)) Then
                        ' Adjust this condition to fit your specific comparison needs
                        If newValue = ws2CArray(j, 1) Then
                            matchFound = True
                            Exit For
                        End If
                    End If
                Next j
                
                ' Output results to the Immediate Window (customize this part as needed)
                If matchFound Then
                    Debug.Print "Period " & period * 10 & " years: Value " & newValue & " found in Worksheet2 C column at row " & j
                Else
                    Debug.Print "Period " & period * 10 & " years: Value " & newValue & " NOT found in Worksheet2 C column"
                End If
            End If
        Next i
    Next period
    
    ' Clean up object references
    Set ws1 = Nothing
    Set ws2 = Nothing
End Sub

Key Details & Customization #

• 10-Year Segmentation: The loop calculates the end row of the H column range dynamically (e.g., period 1 = H20:H30, period 2 = H20:H40). Update maxPeriods to match how many decades you need to process.
• Array Efficiency: Loading ranges into arrays instead of looping through individual cells cuts down on processing time—critical for large datasets.
• Flexible Comparison: The current code checks for exact matches in Worksheet2’s C column. Modify the If newValue = ws2CArray(j,1) line to fit your needs (e.g., check if newValue falls between two values, is greater than a threshold, etc.).
• Output Options: Instead of printing to the Immediate Window (Debug.Print), you can write results directly to a worksheet (e.g., ws1.Cells(i+20, "I").Value = "Found").

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