仅当某个区域中的随机单元格具有值-Excel时，才选择该区域中的随机单元格

下面是我目前使用的VBA代码。它工作得很好，但我需要扩大范围以检查其他单元格，但其中一些单元格可能包含空单元格，我不想选择这些单元格

有没有办法绕过那些空电池

Dim RNG1 As Range
Set RNG1 = Range("H1:H30")

Dim randomCell1 As Long
    randomCell1 = Int(Rnd * RNG1.Cells.Count) + 1

With RNG1.Cells(randomCell1)
.Select
'will do something else here, like copy the cell, fill the cell with a color, etc
End With

---

虽然有点晚了，但发布也无妨：

Sub test()

Dim rng As Range, cel As Range
Dim NErng
Dim i As Integer

Set rng = Range("A1:A15")

For Each cel In rng
    If Len(cel) <> 0 Then
        If IsArray(NErng) Then
            ReDim Preserve NErng(UBound(NErng) + 1)
            NErng(UBound(NErng)) = cel.Address
        ElseIf IsEmpty(NErng) Then
            NErng = cel.Address
        Else
            NErng = Array(NErng, cel.Address)
        End If
    End If
Next

i = Int((UBound(NErng) - LBound(NErng) + 1) * Rnd + LBound(NErng))
Debug.Print Range(NErng(i)).Address

End Sub

尝试使用IsEmptyRNG1.CellsrandomCell1

---

编辑-@brettdj是对的。这是为了更好地回答跳过这些单元格的问题而调整的

试试这个：

DangThisCellIsBlank:
RandomCell = Int(Rnd * RNG1.Cells.Count) + 1

With RNG1.Cells(RandomCell)
    If .Value <> "" Then
        'do stuff
    Else
        'go back and pick another cell
        GoTo DangThisCellIsBlank
    End If
End With

---

这应仅拾取非空单元格：

Sub marine()
    Dim RNG1 As Range, r As Range, c As Collection
    Set c = New Collection
    Set RNG1 = Range("H1:H30")
    For Each r In RNG1
        If r.Value <> "" Then
            c.Add r
        End If
    Next r
    Dim N As Long
    N = Application.WorksheetFunction.RandBetween(1, c.Count)
    Set rselect = c.Item(N)
    rselect.Select
End Sub

注:

---

这是一个通用技术的示例。要从范围的子集中随机选取，请收集子集并从集合中选取。

如果H列中的值是XlConstants，则使用特殊单元格执行类似操作

---

不会像RNG1那样工作。无论有多少空白单元格，Cells.Count将始终=30。不解决此问题。

Sub marine()
    Dim RNG1 As Range, r As Range, c As Collection
    Set c = New Collection
    Set RNG1 = Range("H1:H30")
    For Each r In RNG1
        If r.Value <> "" Then
            c.Add r
        End If
    Next r
    Dim N As Long
    N = Application.WorksheetFunction.RandBetween(1, c.Count)
    Set rselect = c.Item(N)
    rselect.Select
End Sub

Sub Option_B()
Dim rng1 As Range
Dim rng2 As Range
Dim lngCel As Long

On Error Resume Next
Set rng1 = Range("H1:H30").SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub

Dim randomCell1 As Long
randomCell1 = Int(Rnd * rng1.Cells.Count) + 1

For Each rng2 In rng1.Cells
'kludgy as there will be multiple areas in a SpecialFCells range with blank cells
lngCel = lngCel + 1
    If lngCel = randomCell1 Then
        Application.Goto rng2
        Exit For
    End If
Next

End Sub