随机选择目标单元格，但无法针对同一单元格两次

Posted 2023-03-29

【中文标题】随机选择目标单元格，但无法针对同一单元格两次

【英文标题】：Randomly select Target cells without being able to target a same cell twice

【发布时间】：2015-05-16 16:29:00

【问题描述】：

我尝试了多种方法，但仍然无法解决我的问题。

我可以在代码中添加什么以便不能在 Range("A5:G11") 中定位相同的值两次，并且只能在 Range("A5:G11 ") 当时？

这是我目前所拥有的。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim valeur As Range, c As Range, KeyRange As Range

If Target.Cells.Count > 1 Then
    Exit Sub

        ElseIf Not (Intersect(Target, Range("A5:G11")) Is Nothing) Then
            Target.Interior.ColorIndex = 3
        Else

    Exit Sub
End If

Set valeur = Range("C14:C19")

For Each c In valeur.Cells
    If c.value = "" Then
        c.value = Target.value
            Exit Sub
    End If
Next c

On Error Resume Next

Set KeyRange = Range("C14")
valeur.Sort Key1:=KeyRange, Order1:=xlAscending

结束子

【问题讨论】：

我可以添加什么以便不能在 Range("A5:G11") 中定位相同的值两次，并且一次最多只能定位 6 个值？

【参考方案1】：

试试这个：

**您需要先按住Ctrl键盘键选择单元格，然后运行此方法。

  Sub DoCopyBySelectionOrder()
    Const MAX_SELECTION As Integer = 6

    Dim oFirstTargetCell As Range
    Dim oTmpCell As Range
    Dim oCell As Range
    Dim sSrcRange As String
    ' r- for rows, c- for columns
    Dim r%
    Dim iCount As Integer

    r = 0
    iCount = 0

    sSrcRange = "A5:G11"

    Set oFirstTargetCell = ActiveSheet.Range("A14")

    For Each oCell In Selection
        If IsEmpty(oCell) = False Then
            If oCell.Text <> "" Then
                If Not (Intersect( _
                        oCell, ActiveSheet.Range(sSrcRange)) Is Nothing) Then
                    ' In the first pass the cell returned will be A14 because
                    ' r is 0 at that point.
                    Set oTmpCell = oFirstTargetCell.Offset(r, 0)
                    oTmpCell.Value = oCell.Value

                    iCount = iCount + 1
                    ' EXIT
                    If iCount >= MAX_SELECTION Then Exit Sub

                    r = r + 1
                End If
            End If
        End If
    Next

End Sub

【讨论】：

我可以添加什么以便不能在 Range("A5:G11") 中定位相同的值两次，并且一次最多只能定位 6 个值？

您可以将 MAX_SELECTION 值更改为您喜欢的任何最大值。我认为不可能两次选择相同的值。我相信要么选择了某些东西。

【参考方案2】：

你有一个好的开始。我们可以通过使用“ElseIf”语句而不是将 If 嵌套在其他 If 中来稍微清理您的代码。然后，为了处理粘贴问题，我们将使用 For Each 循环。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim valeur As Range, C as Range


If Target.Cells.Count > 1 Then
    Exit Sub
ElseIf Not (Intersect(Target, Range("A5:G11")) Is Nothing) Then
    Target.Interior.ColorIndex = 3
Else
    Exit Sub  'No need for the last if statement
End If

set valuer=range("C14:C16")
For each C in valuer.cells
    if c.value="" then
        c.value=Target.value
        exit sub
    end if
Next c

'If get to this step, then the C14:C16 range is full, can put some error handling, reset, etc.

End Sub

您也可以使用 FOR NEXT 循环来完成最后一点，方法是：

For R=14 to 16 'should DIM R as Integer at the top
    if Cells(r,3)="" then
        Cells(r,3).value=Target.value
        exit sub
    end if
Next R

编辑：对问题进行了编辑，因此粘贴的结果应从 C14 开始，然后继续增长。

在这种情况下：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim R as Integer


If Target.Cells.Count > 1 Then
    Exit Sub
ElseIf Not (Intersect(Target, Range("A5:G11")) Is Nothing) Then
    Target.Interior.ColorIndex = 3
Else
    Exit Sub  'No need for the last if statement
End If

R=14
Do While Cells(R,3)<>""
    R=R+1
Loop
Cells(R,3)=Target.value

End Sub

【讨论】：

我可以添加什么以便不能在 Range("A5:G11") 中定位相同的值两次，并且一次最多只能定位 6 个值？

在您包含的代码中，您已经将单元格的颜色索引更改为“3”。为了防止同一个单元格被选中两次，只需添加： ElseIf Not (Intersect(Target, Range("A5:G11")) Is Nothing) 和 Target.interior.colorindex3 然后。要仅针对最多 6 个单元格，您可以返回到第一个解决方案（使用估值器范围），将该范围设置为 6 个单元格（C14:C19），然后在我对错误处理有评论的地方添加任何你如果所有地点都已满，则想做。