请求协助编写Excel VBA条件行合并代码（多年未接触VB）

Hey there! No worries if you haven't touched VBA since college—let's figure out how to get that conditional row merging working for your Excel sheet. Since I can't see your Figure 1 and Figure 2, I'll go with the most common scenario: merging rows that share the same value in a key column (like Column A) and combining their content in other columns. This should cover most use cases, but feel free to tweak it if your needs are specific!

First, make sure you've backed up your Excel file (better safe than sorry!). Then, open the VBA editor by pressing Alt + F11.

Insert a new module (go to Insert > Module), then paste this code:

Sub MergeRowsConditionally()
    Dim targetSheet As Worksheet
    Dim lastRow As Long, currentRow As Long, colNum As Long
    Dim keyColumn As Integer, startMergeColumn As Integer
    
    ' --- Customize these values to match your sheet ---
    Set targetSheet = ThisWorkbook.Worksheets("Sheet1") ' Replace with your sheet name
    keyColumn = 1 ' Column A = 1, Column B = 2, etc. (the column to check for duplicates)
    startMergeColumn = 2 ' Start merging content from this column (e.g., Column B = 2)
    Dim separator As String: separator = ", " ' Change this to your preferred separator (e.g., vbCrLf for new lines)
    ' --- End customization ---
    
    ' Speed up the code by disabling screen updates
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' Find the last row with data in the key column
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, keyColumn).End(xlUp).Row
    
    ' Loop from bottom to top (avoids issues when deleting rows)
    For currentRow = lastRow To 2 Step -1
        ' Check if current row's key matches the row above it
        If targetSheet.Cells(currentRow, keyColumn).Value = targetSheet.Cells(currentRow - 1, keyColumn).Value Then
            ' Merge content across all columns starting from startMergeColumn
            For colNum = startMergeColumn To targetSheet.Cells(1, targetSheet.Columns.Count).End(xlToLeft).Column
                If targetSheet.Cells(currentRow, colNum).Value <> "" Then
                    ' Only add separator if the upper cell already has content
                    If targetSheet.Cells(currentRow - 1, colNum).Value <> "" Then
                        targetSheet.Cells(currentRow - 1, colNum).Value = targetSheet.Cells(currentRow - 1, colNum).Value & separator & targetSheet.Cells(currentRow, colNum).Value
                    Else
                        targetSheet.Cells(currentRow - 1, colNum).Value = targetSheet.Cells(currentRow, colNum).Value
                    End If
                End If
            Next colNum
            ' Delete the duplicate row
            targetSheet.Rows(currentRow).Delete
        End If
    Next currentRow
    
    ' Re-enable screen updates and events
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    MsgBox "Row merging complete!", vbInformation
End Sub

Tweak the values in the Customize these values section:

• targetSheet: Replace "Sheet1" with your actual worksheet name (e.g., "SalesData").
• keyColumn: Set this to the column number you want to use as the duplicate check (e.g., if your key is in Column C, use 3).
• startMergeColumn: Set this to the first column where you want to combine content (e.g., if you want to merge Columns C to E, start with 3).
• separator: Change ", " to whatever you want between merged content—use vbCrLf if you want each entry on a new line.

Go back to Excel, press Alt + F8, select MergeRowsConditionally, and hit Run. You'll get a pop-up when it's done!

• If your merging rule is different (e.g., merging based on multiple columns, or formatting merged cells), just let me know the details and I can adjust the code.
• Always test on a copy of your data first—VBA can't undo changes easily!

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