Excel VBA修改范围和选择随机单元格

时间:2018-05-29 06:59:58

标签: excel-vba vba excel

我有一个单元格区域,我从中选择一个单元格,从范围中删除单元格,然后选择另一个随机单元格。该循环总共执行6次。

每个循环完成后,Range.Count和Range.Address都会反映删除,但是当循环运行时,它将继续可能选择已删除的单元格。我在别处使用细胞去除功能,它按预期执行。

如果该范围的计数和地址都显示删除,为什么这些删除的单元格被选中?我做错了什么?

代码如下:

someRange = RangeToString(namesList)
    MsgBox someRange

    someDate = namesSheet.Range("F12").Value
    For i = 1 To 3
        For j = 1 To 2
            For k = 1 To namesList.Count
                Set randomName = GetRandomName(namesList)
                MsgBox randomName & " was selected for date " & someDate & " and the size of the range is: " & namesList.Count
                available = AvailabilityCheck(randomName, someDate )
                If available = True Then
                    If i = 1 And j = 1 Then
                        namesSheet.Cells(18, "E").Value = randomName
                    ElseIf i = 1 And j = 2 Then
                        namesSheet.Cells(19, "E").Value = randomName
                    ElseIf i = 2 And j = 1 Then
                        namesSheet.Cells(18, "I").Value = randomName
                    ElseIf i = 2 And j = 2 Then
                        namesSheet.Cells(19, "I").Value = randomName
                    ElseIf i = 3 And j = 1 Then
                        namesSheet.Cells(18, "K").Value = randomName
                    ElseIf i = 3 And j = 2 Then
                        namesSheet.Cells(19, "K").Value = randomName
                    End If

                    Set namesList = ExcludeCell(namesList, genSheet.Range(randomName.Address))
                    namesString = RangeToString(namesList)
                    MsgBox namesList.Address
                Exit For
                End If
            Next k
        Next j
        If i = 1 Then
            someDate = namesSheet.Range("J12").Value
        Else
            someDate = namesSheet.Range("L12").Value
        End If
    Next i
    Set FooFunction = namesList

删除细胞的功能是:

Function ExcludeCell(ByVal rngMain As Range, rngExc As Range) As Range

    Dim rngTemp     As Range
    Dim RNG         As Range

    Set rngTemp = rngMain
    Set rngMain = Nothing

    For Each RNG In rngTemp
        If RNG.Address <> rngExc.Address Then
            If rngMain Is Nothing Then
                Set rngMain = RNG
            Else
                Set rngMain = Union(rngMain, RNG)
            End If
        End If
    Next
    Set ExcludeCell = rngMain
End Function

1 个答案:

答案 0 :(得分:0)

这不是排除功能,而是我正在使用的随机单元格生成器。由于我没有处理连续的范围,我需要在随机生成器代码中考虑到这一点。

以下是之前:

Function GetRandomName(namesList As Range) As Range

    Dim randomName As Long
    randomName = Int(Rnd * namesList.Cells.Count) + 1

    Set GetRandomName = namesList.Cells(randomName)

End Function

这是后:

Function GetRandomName(namesList As Range) As Range

    Dim randomCell As Integer
    Dim randomName As Range

    Do
        randomCell = Int(Rnd * namesList.Cells.Count) + 1
        Set randomName = namesList.Cells(randomCell)

        If (randomName.Parent.name = namesList.Parent.name) Then
            Dim ints As Range

            For Each cell In namesList
                Set ints = Application.Intersect(cell, randomName)
                If (Not (ints Is Nothing)) Then
                    Set GetRandomName = randomName
                    Exit Do
                End If
            Next cell
        End If
    Loop
End Function