VBA Rows.Count in Selection

Question

我正在計算出用戶選擇顯示在工作表按鈕I.e旁邊工作表頂部的行數。按鈕顯示「生成電子郵件」，旁邊顯示「已選擇x項」。

由於這是每次更新的選擇改變時，我有以下代碼：

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    Sheet1.Range("E1") = Target.Rows.Count & " items selected" 
End Sub 

此工作正常，如果用戶選擇連續行，對於例如7:10返回4.

我的問題是如果用戶選擇了行7和10.它只會返回1（選擇的第一部分中的行）。

從我發現，沒有辦法從屬性中獲取這個值，但我無法得到我的頭周圍如何遍歷選擇/目標的所有部分，並計算行的總和。那麼也有可能用戶選擇說A7，C7和A10。 A7和C7涉及相同的項目，所以這應該只能真正被視爲一個，而不是兩個，我認爲我的假設代碼會做...

有沒有人試圖實現這一點，並已成功或可能點我在一些可能有所幫助的房產方向？我嘗試了一個單獨的功能來實現它，但那也不起作用。

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    Sheet1.Range("E1") = getRowCount(Target) & " items selected" 
End Sub 

Function getRowCount(selectedRanges As Ranges) 
    rowCount = 0 
    For Each subRange In selectedRanges 
    rowCount = rowCount + subRange.Rows.Count 
    Next 

    getRowCount = rowCount 
End Function 

Answer 1

我認爲這會工作。 （沒有當我嘗試了。）

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    'Create a range containing just column A 
    Dim subRange As Range 
    Dim r As Range 
    For Each subRange In Target.Areas 
     If r Is Nothing Then 
      Set r = subRange.EntireRow.Columns(1) 
     Else 
      Set r = Union(r, subRange.EntireRow.Columns(1)) 
     End If 
    Next 
    'Count how many cells in the combined column A range 
    Sheet1.Range("E1") = r.Cells.Count & " items selected" 
End Sub 

Answer 2

您需要計算用戶選擇的每個Area中的行。
https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-areas-property-excel

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

    Dim rArea As Range 
    Dim lCount As Long 

    For Each rArea In Selection.Areas 
     lCount = lCount + rArea.Rows.Count 
    Next rArea 

    Sheet1.Range("E1") = lCount 

End Sub 

Answer 3

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
Dim cell As Range 
Dim i, currentRow As Long: i = 0 
'get row of first cell in range 
currentRow = Target.Cells(1, 1).row 

For Each cell In Target 
    'if row is different, then increase number of items, as it's next item 
    If Not currentRow = cell.row Then 
     i = i + 1 
     currentRow = cell.row 
    End If 
Next cell 

Range("E1").Value = i 

End Sub 

Answer 4

Sub NumberOfRowsSelected() 
Dim vMatch As Variant, aRows() As Long, r As Range, x As Long 

ReDim Preserve aRows(x) 
aRows(x) = 0 

For Each r In Selection.Cells 
    vMatch = Application.Match(r.Row, aRows, 0) 

    If IsError(vMatch) Then 
     x = x + 1 
     ReDim Preserve aRows(0 To x) 
     aRows(x) = r.Row 
    End If 
Next r 

MsgBox UBound(aRows) 

End Sub 

修改過的代碼轉換爲功能

Sub NumberOfRowsSelected() 
    MsgBox RowsCount(Selection) 
End Sub 

Function RowsCount(rRange As Range) As Long 
Dim vMatch As Variant, aRows() As Long, r As Range, x As Long 

ReDim Preserve aRows(x) 
aRows(x) = 0 

For Each r In rRange.Cells 
    vMatch = Application.Match(r.Row, aRows, 0) 

    If IsError(vMatch) Then 
     x = x + 1 
     ReDim Preserve aRows(0 To x) 
     aRows(x) = r.Row 
    End If 
Next r 

RowsCount = UBound(aRows) 

End Function 

Answer 5

一種不同的方法，建立檢查行的字符串似乎相當直截了當，以避免雙重計算。查看評論的詳細信息：

Function getRowCount(rng As Range) As Long 
    Dim c As Range 
    ' Keep track of which rows we've already counted 
    Dim countedrows As String: countedrows = "," 
    ' Loop over cells in range 
    For Each c In rng 
     ' Check if already counted 
     If Not InStr(countedrows, "," & c.Row & ",") > 0 Then 
      ' Add to counted list 
      countedrows = countedrows & c.Row & "," 
     End If 
    Next c 
    ' Get number of rows counted 
    Dim rowsarr() As String: rowsarr = Split(countedrows, ",") 
    getRowCount = UBound(rowsarr) - LBound(rowsarr) - 1 
End Function