vba 仅当有值时才选择范围内的随机单元格 - Excel
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/22963669/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Select Random Cell In A Range Only If It Has A Value - Excel
提问by Muhnamana
So here is the following VBA code I'm currently using. It works perfectly but I need to expand the range to check additional cells but some of those cells could contain empty cells and I don't want to select those.
所以这是我目前使用的以下 VBA 代码。它运行良好，但我需要扩大范围以检查其他单元格，但其中一些单元格可能包含空单元格，我不想选择这些单元格。
Is there a way to bypass those empty cells?
有没有办法绕过那些空单元格？
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
回答by Gary's Student
This should pick only non-empty cells:
这应该只选择非空单元格：
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
NOTE:
笔记：
This is an example of a general technique. To make a random pick from a subsetof a range, collect the subset and pick from the Collection.
这是一个通用技术的例子。要从范围的子集中进行随机选择，请收集子集并从集合中进行选择。
回答by brettdj
If the values in column H were XlConstantsthen something like this using SpecialCells
如果 H 列中的值XlConstants是这样的，则使用SpecialCells
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
回答by L42
A bit too late but no harm in posting :)
有点晚了，但发布没有坏处:)
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
回答by Dan Wagner
EDIT -- @brettdj is right. This is adjusted to better answer the "skip these cells" question.
编辑——@brettdj 是对的。这经过调整以更好地回答“跳过这些单元格”问题。
Try this out:
试试这个：
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
回答by hstay
Try with IsEmpty(RNG1.Cells(randomCell1))
试试 IsEmpty(RNG1.Cells(randomCell1))
Dim RNG1 As Range
Set RNG1 = Range("H1:H30")
Dim randomCell1 As Long
randomCell1 = Int(Rnd * RNG1.Cells.Count) + 1
'Keep Looping until you find a non empty cell
Do While IsEmpty(RNG1.Cells(randomCell1))
randomCell1 = Int(Rnd * RNG1.Cells.Count) + 1
Loop
'================================================
With RNG1.Cells(randomCell1)
.Select
'will do something else here, like copy the cell, fill the cell with a color, etc
End With
