Question

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

为了无法在Range（“A5：G11”）中定位相同的值两次，我只能添加到代码中，并且只能在Range中定位最多6个值（“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

End Sub

Answer 1

你有一个良好的开端。我们可以使用＆＃34; ElseIf＆＃34;来清理你的代码。声明而不是嵌套如果在其他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

Answer 2

试试这个：

**您需要先按住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

随机选择目标细胞而不能将同一细胞定位两次

2 个答案: