excel VBA程序，要求在合并第一列相同的单元格，以及在第一列相同的条件下，合并第二列相同的单元格

Question

如题所述

Answer 1

Sub 单元格合并()
    Dim x As Integer
    Dim rg As Range
    Set rg = Range("a2")
    For x = 2 To 14  '这里的14是A列单元格的个数，可以进行修改
        If Range("a" & x) = Range("a" & x + 1) Then  '这里的a代表A列
            Set rg = Union(rg, Range("a" & x + 1))
        Else
            Application.DisplayAlerts = False
            rg.Merge
            Application.DisplayAlerts = True
            Set rg = Range("a" & x + 1)
        End If        
    Next x        
End Sub

Answer 2

把文件传到百度云（yun.baidu.com上传很简单），我把VBA写在你的文件里再回给你。追问

http://pan.baidu.com/s/1cMeVqm
这是文件

追答

程序代码：

Option Explicit
Sub 合并相同行()
    Dim arr, i, j, k, st As Worksheet
    Set st = Sheets(1)
    arr = st.Cells(1, 1).CurrentRegion
    For i = UBound(arr) To 2 Step -1
        If arr(i, 1) = arr(i - 1, 1) Then
            If arr(i, 2) = arr(i - 1, 2) Then arr(i, 2) = ""
            arr(i, 1) = ""
        End If
    Next i
    Set st = Sheets(2)
    st.Cells(1, 1).Resize(UBound(arr), 3) = arr
    For j = 1 To 2
        i = UBound(arr)
        While i > 1
            If st.Cells(i, j) = "" Then
                k = st.Cells(i, j).End(xlUp).Row
                st.Range(st.Cells(k, j), st.Cells(i, j)).Merge
                i = k - 1
            Else
                i = i - 1
            End If
        Wend
    Next j
End Sub

详见附件，合并后的数据在表2中，表1的数据没有改动。

本回答被网友采纳