Excel VBA 多条件汇总与合并

Sub 找备注()
Set 单元格 = Cells.Find("备注", lookat:=xlWhole, searchorder:=xlRows)
If Not 单元格 Is Nothing Then
    第一个找到符合内容的地址 = 单元格.Address
End If

Do While Not 单元格 Is Nothing
    列字母 = Left(Mid(单元格.Address, 2), InStr(Mid(单元格.Address, 2), "$") - 1)
    列号 = Range(列字母 & "1").Column
    'Debug.Print 列号
    Call 写备注(列号)
    Set 单元格 = Cells.Find("备注", after:=单元格)
    If 单元格.Address = 第一个找到符合内容的地址 Then Exit Do
Loop
End Sub

Sub 写备注(列号)
For i = -1 To -(列号 - 1) Step -1
    If Not Cells(1, 列号).Offset(0, i) Like "RMB*" Then
        最小 = 列号 + i + 1
        最大 = 列号 - 1
        j = 2
        Do While Range("A" & j) <> ""
            For k = 最小 To 最大
                If Cells(j, k) <> "" Then
                    n = n + 1
                    s = s & Cells(1, k) & ":" & Cells(j, k) & "," & Chr(10)
                End If
            Next
            If n >= 2 Then
                Cells(j, 列号) = Left(s, Len(s) - 2)
            End If
            n = 0
            s = ""
            j = j + 1
        Loop
        Exit For
    End If
Next