excel吧 关注：281,355贴子：1,549,793
贴吧里边找的。温柔小兔写的，没试过。
http://tieba.baidu.com/p/2488583858
Sub 合并单元格()
a = Selection.Column
Columns(a + 1).Insert
For i = 1 To Cells(65536, a).End(xlUp).Row
If i = 1 Then m = 1
If Cells(i, a) <> Cells(i + 1, a) Or Len(Cells(i, a)) <> Len(Cells(i + 1, a)) Then
Range(Cells(m, a + 1), Cells(i, a + 1)).Merge
m = i + 1
End If
Next
Columns(a + 1).Copy
Columns(a).PasteSpecial Paste:=xlPasteFormats
Columns(a + 1).Delete
End Sub
http://tieba.baidu.com/p/2488583858
Sub 合并单元格()
a = Selection.Column
Columns(a + 1).Insert
For i = 1 To Cells(65536, a).End(xlUp).Row
If i = 1 Then m = 1
If Cells(i, a) <> Cells(i + 1, a) Or Len(Cells(i, a)) <> Len(Cells(i + 1, a)) Then
Range(Cells(m, a + 1), Cells(i, a + 1)).Merge
m = i + 1
End If
Next
Columns(a + 1).Copy
Columns(a).PasteSpecial Paste:=xlPasteFormats
Columns(a + 1).Delete
End Sub
Sub 合并等值()
Dim rgScan As Range, rgPrev As Range, rgFirst As Range
Application.DisplayAlerts = False
Set rgFirst = Selection(1, 1)
Set rgPrev = Selection(1, 1)
For Each rgScan In Selection
If rgScan <> rgFirst Then
Range(rgFirst, rgPrev).Merge
Set rgFirst = rgScan
End If
Set rgPrev = rgScan
Next rgScan
Range(rgFirst, rgPrev).Merge
Application.DisplayAlerts = True
End Sub
忘记是谁写的了，一直用的这个，选中要合并的列，然后运行宏就行
Dim rgScan As Range, rgPrev As Range, rgFirst As Range
Application.DisplayAlerts = False
Set rgFirst = Selection(1, 1)
Set rgPrev = Selection(1, 1)
For Each rgScan In Selection
If rgScan <> rgFirst Then
Range(rgFirst, rgPrev).Merge
Set rgFirst = rgScan
End If
Set rgPrev = rgScan
Next rgScan
Range(rgFirst, rgPrev).Merge
Application.DisplayAlerts = True
End Sub
忘记是谁写的了，一直用的这个，选中要合并的列，然后运行宏就行
