獲取使用VBA

Question

我需要找出第一小區和垂直合併單元格的最後一個單元格開始與Excel中的一個垂直合併單元格的範圍和結束範圍..

比方說，我合併單元格B2到B50 。
我怎樣才能在VBA中獲得開始單元格（= B2）和結束單元格（= B50）？

Answer 1

好吧，假設你知道在合併範圍內的小區之一的地址，你可以只選擇該範圍內的偏移量並得到行/列：

Sub GetMergedRows() 
    Range("A7").Select 'this assumes you know at least one cell in a merged range. 
    ActiveCell.Offset(-1, 0).Select 
    iStartRow = ActiveCell.Row + 1 
    Range("A7").Select 
    ActiveCell.Offset(1, 0).Select 
    iEndRow = ActiveCell.Row - 1 
    MsgBox iStartRow & ":" & iEndRow 
End Sub 

上面的代碼將拋出錯誤如果無法選擇偏移行（即，如果合併的行是A1，則通過任何方式），因此您需要添加錯誤處理，以告知代碼是否無法偏移，最上面的行必須爲1，如果不能下行，最下面一行必須是65,536。這個代碼也只是一維的，所以你可能想要添加x軸。

Answer 2

如果您希望單元格引用爲字符串，您可以使用類似這樣的內容，其中Location，StartCell和EndCell是字符串變量。

Location = Selection.Address(False, False) 
Colon = InStr(Location, ":") 
If Colon <> 0 Then 
    StartCell = Left(Location, Colon - 1) 
    EndCell = Mid(Location, Colon + 1) 
End If 

如果你想將它們設置爲範圍，你可以添加這個，其中StartRange和EndRange是Range對象。

set StartRange = Range(StartCell) 
set EndRange = Range (EndCell) 

Answer 3

Sub MergedAreaStartAndEnd() 

    Dim rng As Range 
    Dim rngStart As Range 
    Dim rngEnd As Range 

    Set rng = Range("B2") 

    If rng.MergeCells Then 

     Set rng = rng.MergeArea 
     Set rngStart = rng.Cells(1, 1) 
     Set rngEnd = rng.Cells(rng.Rows.Count, rng.Columns.Count) 

     MsgBox "First Cell " & rngStart.Address & vbNewLine & "Last Cell " & rngEnd.Address 

    Else 

     MsgBox "Not merged area" 

    End If 

End Sub 

Answer 4

下面的宏經過工作簿中的所有工作表，發現合併單元格，取消合併，並把原來的值給所有的合併單元格。

這是DB應用程序經常需要的，所以我想和大家分享一下。

Sub BirlesenHucreleriAyirDegerleriGeriYaz() 
    Dim Hucre As Range 
    Dim Aralik 
    Dim icerik 
    Dim mySheet As Worksheet 

    For Each mySheet In Worksheets 

    mySheet.Activate 
    MsgBox mySheet.Name & 「 yapılacak…」 

    For Each Hucre In mySheet.UsedRange 
     If Hucre.MergeCells Then 
      Hucre.Orientation = xlHorizontal 
      Aralik = Hucre.MergeArea.Address 
      icerik = Hucre 
      Hucre.MergeCells = False 
      Range(Aralik) = icerik 
     End If 
    Next 

MsgBox mySheet.Name & " Bitti!!" 

Next mySheet 
End Sub