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