在excel中,当某一列有大量相同数据的时候,需要将这些相同的数据合并在一起,当然你可以使用排序的方法,把这些数据排在一起,但在对照其它数据的时候看起来都不怎么直观,这时需要将相同数据合并在一个单元格,如果数据量太大手工合并很费时,下面说下用宏自动合并单元格的方法,一说到宏大家都觉得和编程分不开,其实都很简单的。
下面是合并前和合并后的对比图,这个宏对于合并大量数据还是非常有用的,这个宏里用到两个函数,hebing1函数合并单元格、hebing用来判断合并的位置,并调用了hebing1这个函数。
1、合并某一指定列里的相同项,且某一指定列必须相同
宏代码如下:
[cc lang=”php”]
‘合并单元格的函数’
Sub hebing1(ByVal str, ByVal m, ByVal n)
‘选择相同的数据’
Range(str & m & “:” & str & n).Select
‘合并数据’
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
End Sub
‘用来判断合并的位置的函数’
Sub hebing()
Dim i As Integer
Dim m As Integer
Dim n As Integer
Dim f As Integer
Dim str As String
m = 0
n = 0
f = 0
‘输入行和列’
str = InputBox(“输入要合并的EXCEL表格列标号,例如A或B:”)
str2 = InputBox(“输入条件表格列标号:”)
i = InputBox(“请输入处理的EXCEL表格开始的行数,例如第二行就填2:”)
If i = False Then
GoTo A
End If
If str = “” Then
GoTo A
End If
While Range(str & i) <> “”
If (Range(str & i) = Range(str & i + 1)) And (Range(str2 & i) = Range(str2 & i + 1)) Then
If f = 0 Then
m = i
f = 1
End If
Else
If f = 0 Then
m = i
End If
n = i
‘调用hebing1函数进行合并’
Call hebing1(str, m, n)
f = 0
End If
i = i + 1
Wend
A:
End Sub
[/cc]
2、只对某一列的单元格里的相同项进行合并
如果只对一个单元格里的相同项进行合并,那么可以去掉中间的条件条件判断,宏代码如下:
[cc lang=”php”]
‘合并单元格的函数’
Sub hebing1(ByVal str, ByVal m, ByVal n)
‘选择相同的数据’
Range(str & m & “:” & str & n).Select
‘合并数据’
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
End Sub
‘用来判断合并的位置的函数’
Sub hebing()
Dim i As Integer
Dim m As Integer
Dim n As Integer
Dim f As Integer
Dim str As String
m = 0
n = 0
f = 0
‘输入行和列’
str = InputBox(“输入要合并的EXCEL表格列标号,例如A或B:”)
i = InputBox(“请输入处理的EXCEL表格开始的行数,例如第二行就填2:”)
If i = False Then
GoTo A
End If
If str = “” Then
GoTo A
End If
While Range(str & i) <> “”
If (Range(str & i) = Range(str & i + 1)) Then
If f = 0 Then
m = i
f = 1
End If
Else
If f = 0 Then
m = i
End If
n = i
‘调用hebing1函数进行合并’
Call hebing1(str, m, n)
f = 0
End If
i = i + 1
Wend
A:
End Sub
[/cc]