Excel 宏vba 自動合併單元列

需求：

根據列合併； 同一列中相鄰內容一致的合併成一個單元格， 以變美觀

 

分析：

在須要合併的sheet中， 加入一個按鈕， 點擊此按鈕

出現提示框， 讓用戶本身輸入須要合併的列； 列名能夠爲數字或字母； 如輸入1， 表明第一列； 輸入A， 也表明第一列

自動判斷全部的行數；

進行循環遍歷； 將此列內容相同的相鄰2列或幾列， 合併單元格

難點:

合併單元格總出現提示框， 警告將丟失部分信息； 解決辦法application.displayallert=false; 取消警告框；遍歷完畢後， 再恢復displayalert=true

源代碼：

Option Explicit

Sub MergeCol()
    Dim iCol As Integer
  
    Dim strCol    As String
    strCol = InputBox("Please Input the column you want to merge")
    strCol = Trim(strCol)
    Dim strColName As String
    If strCol = "" Then
        Exit Sub
    End If
    If IsNumeric(Trim(strCol)) Then
        iCol = CInt(Trim(strCol))
        strColName = GetColumnName(iCol)
    Else
        strColName = strCol
        iCol = GetColumnNum(strCol)
  
    End If
    'get max rows
    Dim Rows_count As Integer
    Rows_count = ActiveSheet.UsedRange.Rows.Count

    'MsgBox iRows
    Dim iCurrow As Integer
    Application.DisplayAlerts = False
  
    iCurrow = 2
    Dim strTemp1 As String
    Dim strTemp2 As String
    Dim j As Integer
    Dim icolMerge As Integer
    Dim iOriginal As Integer
    While (iCurrow < Rows_count)
        strTemp1 = ActiveSheet.Cells(iCurrow, iCol).Value
        icolMerge = iCurrow
        iOriginal = iCurrow
        If Trim(strTemp1) <> "" Then
            For j = iCurrow + 1 To Rows_count
                strTemp2 = Sheet1.Cells(j, iCol).Value
                If Trim(strTemp1) = Trim(strTemp2) Then
                  icolMerge = j
                  iCurrow = j
                Else
                  iCurrow = j
                  Exit For
                End If
              
            Next
        Else
             iCurrow = iCurrow + 1
        End If
        If (icolMerge > iOriginal) Then
            'ActiveSheet.Range(strColName & iOriginal, strColName & icolMerge).MergeCells = True
            ActiveSheet.Range(strColName & iOriginal & ":" & strColName & icolMerge).MergeCells = True
          
          
        End If
   
  
    Wend
    Application.DisplayAlerts = True
End Sub

Function GetColumnNum(ByVal ColumnName As String) As Integer
Dim Result As Integer, First As Integer, Last As Integer

Result = 1
If Trim(ColumnName) <> "" Then
    If Len(ColumnName) = 1 Then
        Result = Asc(UCase(ColumnName)) - 64
    ElseIf Len(ColumnName) = 2 Then
        If UCase(ColumnName) > "IV" Then ColumnName = "IV"
        First = Asc(UCase(Left(ColumnName, 1))) - 64
        Last = Asc(UCase(Right(ColumnName, 1))) - 64
        Result = First__ * 26 + Last
    End If
End If
GetColumnNum = Result

End Function

Function GetColumnName(ByVal ColumnNum As Integer) As String
Dim First As Integer, Last As Integer
Dim Result As String
If ColumnNum > 256 Then ColumnNum = 256
First = Int(ColumnNum / 27)
Last = ColumnNum - (First * 26)
If First > 0 Then
Result = Chr(First + 64)
End If
If Last > 0 Then
Result = Result & Chr(Last + 64)
End If

GetColumnName = Result End Function