如何在输入框中禁用多行/列选择？

Question

如果用户同时选择多个行和列，我正在寻找一种在输入框中禁用多重选择的方法。我已经尝试过此代码：

Dim rng As Range
Set rng = Application.InputBox("dasdasd", "asdas", "", Type:=8)

If rng.Columns.Count > 1 And rng.Rows.Count > 1 Then
    MsgBox "Multiple selection allowed only within the same row or column"
    Exit Sub
Else
    'carry on
End If

我想做的是同时禁用多列和多行选择。例如-如果我选择（使用ctrl键）范围“ D1：D5”，“ D8：D10”，那么它是正确的，因为这是在ONE列中的多行选择。如果我选择“ D1：D5”，“ E8：E10”，那么它将弹出错误消息框msgbox。如果只选择了一行或一列，则应继续进行操作。如果选择了多行多列，则应退出sub。

上面的代码总是返回一行或一列，无论我在许多行/列中选择了多少范围。我已经尝试了当前的区域方法，但是这会选择整个区域，即使我没有选择的东西...

我将非常感谢您的帮助。

Answer 1

您可以遍历这些区域，并保持所选内容覆盖的行和列的计数。使用两个字典似乎有些矫kill过正，但这似乎可以胜任。

如果您的范围包含几个不连续的区域，则您的代码将仅考虑第一个块，例如D1：D5

Sub x()

Dim oDicR As Object, oDicC As Object, rArea As Range, rCell As Range, rng As Range

Set oDicR = CreateObject("Scripting.Dictionary")
Set oDicC = CreateObject("Scripting.Dictionary")
Set rng = Application.InputBox("dasdasd", "asdas", "", Type:=8)

For Each rArea In rng.Areas
    For Each rCell In rArea
        oDicR(rCell.Row) = 1
        oDicC(rCell.Column) = 1
    Next rCell
    If oDicR.Count > 1 And oDicC.Count > 1 Then
        MsgBox "Multiple selection allowed only within the same row or column"
        Exit Sub
    End If
Next rArea

'do whatever

End Sub

Answer 2

Sub test()

Dim rng As Range, cl As Range, allRng As Range
Dim minRw As Long, minCl As Long, maxRw As Long, maxCl As Long

Set rng = Application.InputBox("dasdasd", "asdas", "", Type:=8)

minRw = 1
minCl = 1

For Each cl In rng

    If cl.Row < minRw Then
    minRw = cl.Row
    Else
    If cl.Row > maxRw Then
    maxRw = cl.Row
    End If
    End If

    If cl.Column < minCl Then
    minCl = cl.Column
    Else
    If cl.Column > maxCl Then
    maxCl = cl.Column
    End If
    End If

Next

Set allRng = Range(Cells(minRw, minCl), Cells(maxRw, maxCl))

If allRng.Rows.Count > 1 And allRng.Columns.Count > 1 Then
    MsgBox "Multiple selection allowed only within the same row or column"
    Exit Sub
End If

End Sub