Access VBA实现按国家-港口聚合运量数据的技术求助

Hey there! Let's sort out this aggregation problem for you. Since you're new to Access VBA, we’ve got two solid approaches to fix this—one using a SQL query (super straightforward for summing data) and another adjusting your original VBA loop to handle the total calculations. Let’s walk through both.

Instead of looping through every single record in VBA, you can leverage Access's built-in SQL GROUP BY functionality to aggregate your Volume values directly. This method is faster, cleaner, and avoids the need for manual loop logic.

Here's the revised code:

Private Sub NewOceanFreight_Click()
    Dim db As DAO.Database
    Set db = CurrentDb
    
    DoCmd.SetWarnings False
    ' Clear all existing records from Test 1 first
    DoCmd.RunSQL "DELETE * FROM [Test 1]"
    ' Run the aggregation query to populate Test 1 with summed values
    DoCmd.RunSQL "INSERT INTO [Test 1] ([Origin Country], [Origin Port], [CBM]) " & _
                 "SELECT [Country], [POL], SUM([Volume]) AS TotalVolume " & _
                 "FROM [2 - Rates 0 Pre-Setup] " & _
                 "GROUP BY [Country], [POL]"
    DoCmd.SetWarnings True
    
    ' Refresh the view to show the updated data
    DoCmd.Requery
End Sub

Breakdown of this code: #

• SUM([Volume]): Calculates the total Volume for each unique combination of Country and POL.
• GROUP BY [Country], [POL]: Groups your source data so we get one row per Country-POL pair, paired with its summed Volume.
• We first clear the Test 1 table, then insert the aggregated results directly into it in one step.

If you want to stick with a VBA loop to learn the underlying logic, you'll need to track existing Country-POL pairs in Test 1 and update their sums instead of adding a new row every time. Here's how to modify your original code:

Private Sub NewOceanFreight_Click()
    Dim db As DAO.Database
    Dim sourceRS As DAO.Recordset
    Dim targetRS As DAO.Recordset
    Dim currentCountry As String
    Dim currentPOL As String
    Dim currentVolume As Integer
    
    Set db = CurrentDb
    Set sourceRS = db.OpenRecordset("2 - Rates 0 Pre-Setup")
    Set targetRS = db.OpenRecordset("Test 1")
    
    DoCmd.SetWarnings False
    DoCmd.RunSQL "DELETE * FROM [Test 1]"
    DoCmd.SetWarnings True
    
    Do Until sourceRS.EOF
        currentCountry = sourceRS![Country]
        currentPOL = sourceRS!POL
        currentVolume = sourceRS!Volume
        
        ' Check if this Country-POL pair already exists in Test 1
        targetRS.FindFirst "[Origin Country] = '" & currentCountry & "' AND [Origin Port] = '" & currentPOL & "'"
        
        If targetRS.NoMatch Then
            ' No existing record—add a new one with the initial volume
            targetRS.AddNew
            targetRS![Origin Country] = currentCountry
            targetRS![Origin Port] = currentPOL
            targetRS![CBM] = currentVolume
            targetRS.Update
        Else
            ' Record exists—update the existing sum
            targetRS.Edit
            targetRS![CBM] = targetRS![CBM] + currentVolume
            targetRS.Update
        End If
        
        sourceRS.MoveNext
    Loop
    
    ' Clean up resources
    sourceRS.Close
    targetRS.Close
    Set sourceRS = Nothing
    Set targetRS = Nothing
    Set db = Nothing
    
    DoCmd.Requery
End Sub

Breakdown of this code: #

• targetRS.FindFirst: Checks if the current Country-POL pair is already present in Test 1.
• If no match is found (targetRS.NoMatch), we add a new row with the current Volume value.
• If a match exists, we edit the existing row and add the current Volume to the stored total.

Quick Notes to Keep in Mind: #

• Double-check that the field names in Test 1 (Origin Country, Origin Port, CBM) match exactly what you're referencing in the code.
• The SQL method is far more efficient for large datasets—loops can slow down significantly if you have thousands of records.
• If your Country or POL values contain single quotes ('), you'll need to escape them by replacing each ' with '' to avoid errors. For example: currentCountry = Replace(sourceRS![Country], "'", "''").

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