可靠地獲取Excel中包含或不包含合并單元格的最后一列

我最近遇到了一個問題，我的get_lcol函式A1在A1:D1合并單元格時回傳。我調整了我的函式來解決這個問題，但后來我有一些其他資料合并了單元格，A1:D1但另一列G又回傳了我的函式，D1所以我再次調整它。問題是我不相信它仍然可以處理所有資料型別，因為它只檢查第 1 行中的合并單元格。

看看下面的資料，我怎樣才能可靠地讓函式回傳，D或者4 不管我將合并的行移到哪里和/或我沒有預見到的任何其他問題？

當前功能：

Public Sub Test_LCol()
 Debug.Print Get_lCol(ActiveSheet)
End Sub

Public Function Get_lCol(WS As Worksheet) As Integer
 Dim sEmpty As Boolean
 On Error Resume Next
 sEmpty = IsWorksheetEmpty(Worksheets(WS.Name))
 If sEmpty = False Then
  Get_lCol = WS.Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
  If IsMerged(Cells(1, Get_lCol)) = True Then
   If Get_lCol < Cells(1, Get_lCol).MergeArea.Columns.Count Then
    Get_lCol = Cells(1, Get_lCol).MergeArea.Columns.Count
   End If
  End If
 Else
  Get_lCol = 1
 End If
End Function

更新：

用函式試試這個資料：

uj5u.com熱心網友回復：

我的作業技術是使用.MergeCells屬性來測驗范圍中是否有任何單元格被合并。并使用該屬性的Cells集合Range.MergeArea來查看是否MergeArea超出了預期的最后一列。

Public Function Get_lCol(ws As Worksheet) As Integer
    If Not IsWorksheetEmpty(ws) Then
        Dim LastCol As Long
        LastCol = ws.Cells.Find(What:="*", After:=ws.[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        
        Dim LastRow As Long
        With ws.UsedRange
            LastRow = .Rows(.Rows.Count).Row
        End With
        
        Dim Cell As Range
        For Each Cell In ws.Cells(1, LastCol).Resize(LastRow, 1)
            If Cell.MergeCells Then
                With Cell.MergeArea
                    If .Cells(.Cells.Count).Column > LastCol Then LastCol = .Cells(.Cells.Count).Column
                End With
            End If
        Next
    Else
        LastCol = 1
    End If
    Get_lCol = LastCol
End Function

uj5u.com熱心網友回復：

@Toddleson 讓我走上正軌，這是我的結尾：

Public Sub Test_LCol()
 Debug.Print Get_lCol(ActiveSheet)
End Sub

Public Function Get_lCol(WS As Worksheet) As Integer
 On Error Resume Next
 If Not IsWorksheetEmpty(WS) Then
  Get_lCol = WS.Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
  Dim Cell As Range
  For Each Cell In WS.UsedRange
   If Cell.MergeCells Then
    With Cell.MergeArea
     If .Cells(.Cells.Count).Column > Get_lCol Then Get_lCol = .Cells(.Cells.Count).Column
    End With
   End If
  Next Cell
 Else
  Get_lCol = 1
 End If
End Function

uj5u.com熱心網友回復：

屬性Find支持的方法UsedRange：什么？

• 說到浪費時間...

Option Explicit

Function GetLastColumn( _
    ByVal ws As Worksheet) _
As Long
    If ws Is Nothing Then Exit Function
    
    ' Using the 'Find' method:
    'If ws.AutoFilterMode Then ws.AutoFilterMode = False ' (total paranoia)
    Dim lcCell As Range
    Set lcCell = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious)
    If Not lcCell Is Nothing Then
        GetLastColumn = lcCell.Column
    End If
    Debug.Print "After 'Find':     " & GetLastColumn
    
    ' Using the 'UsedRange' property (paranoia):
    Dim rg As Range: Set rg = ws.UsedRange
    Dim clColumn As Long: clColumn = rg.Columns.Count   rg.Column - 1
    If clColumn > GetLastColumn Then
        If rg.Address(0, 0) = "A1" Then
            If IsEmpty(rg) Then
                Exit Function
            End If
        End If
        GetLastColumn = clColumn
    'Else ' clColumn is not gt GetLastColumn
    End If
    Debug.Print "Final (if not 0): " & GetLastColumn
    
End Function

Sub GetLastColumnTEST()
    Debug.Print "Sub Result:       " & GetLastColumn(Sheet1)
    Debug.Print Sheet1.UsedRange.Address(0, 0)
End Sub

' It works for a few (?) cells, otherwise it returns 'Null'.
Sub TestMergeCells() ' Useless?! Could someone confirm.
    Debug.Print Sheet1.Cells.MergeCells ' Null for sure
    Debug.Print Sheet1.UsedRange.MergeCells
End Sub

標籤：擅长 vba

上一篇：如果復選框被選中，如何自動發送電子郵件

下一篇：比較列中的單元格并將值寫入新列