Sub MergeCell(ByRef theSheet As Excel.Worksheet, ByVal startRow As Integer, ByVal endRow As Integer, ByVal particularCol As Integer)
Dim intStartRow As Integer
Dim intEndRow As Integer
Dim theCol As Integer 'declare the particular column
'the line of sart and end are detrived from procedure
''''''''''''''''''''''''''''''''''''
'intStartRow = 4
'intEndRow = 101
'theCol = 1
intStartRow = startRow
intEndRow = endRow
theCol = particularCol
'''''''''''''''''''''''''''
Dim flagRow As Integer
Dim i As Integer 'the exteral surround
Dim j As Integer 'the interal round
i = intStartRow
flagRow = intStartRow
With theSheet
Do While i <= intEndRow
For j = i + 1 To intEndRow
If .Cells(i, theCol).Value = .Cells(j, theCol).Value Then
Else
' MsgBox flagRow & "行与" & j - 1 & "行的数据一致!"
' i = j
If flagRow <> j - 1 Then '标志与当前行不一致时合并
'MsgBox transIntToChar(theCol) & flagRow & ":" & transIntToChar(theCol) & j - 1
.Range(transIntToChar(theCol) & flagRow & ":" & transIntToChar(theCol) & j - 1).Merge()
End If
flagRow = j
Exit For
End If
Next
i = j
'看是否到最后了,如果到了最后,则退出外层循环
If i > intEndRow Then
'MsgBox flagRow & "行与" & j - 1 & "行的数据一致!"
If flagRow <> j - 1 Then '标志与当前行不一致时合并
' MsgBox transIntToChar(theCol) & flagRow & ":" & transIntToChar(theCol) & j - 1
.Range(transIntToChar(theCol) & flagRow & ":" & transIntToChar(theCol) & j - 1).Merge()
End If
Exit Do
End If
Loop
End With
End Sub
Function transIntToChar(ByVal kk As Integer) As String
'将数字转换为Excel工作表中的表示列的字母
transIntToChar = Chr(Asc("A") + kk - 1)
End Function