Как отключить выбор нескольких строк / столбцов в поле ввода? - PullRequest
Новая
       68

Как отключить выбор нескольких строк / столбцов в поле ввода?

0 голосов
/ 05 мая 2020

Я ищу способ отключить множественный выбор в моем поле ввода, если пользователь одновременно выбирает несколько строк и столбцов. Я пробовал этот код: 

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», тогда это правильно, так как это выбор нескольких строк, НО в ОДНОМ столбце. Если я выберу «D1: D5», «E8: E10», то должно появиться сообщение об ошибке, msgbox и т. Д. Если выбрана только одна строка или столбец, процедура должна продолжаться. Если было выбрано несколько строк и несколько столбцов, он должен выйти из подпрограммы.

Приведенный выше код всегда возвращает одну строку или один столбец, независимо от того, сколько диапазонов я выбираю для многих строк / столбцов. Я пробовал использовать текущий региональный подход, но он выбирает весь регион, даже то, что я не выбрал ...

Буду благодарен за помощь.

Ответы [ 2 ]

1 голос
/ 05 мая 2020 
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

On Error Resume Next
Set rng = Application.InputBox("dasdasd", "asdas", "", Type:=8)
If rng Is Nothing Then
    MsgBox "You have not selected any range"
    Exit Sub
End If    
Err.Clear
On Error GoTo 0

minRw = rng.Cells(1, 1).Row
minCl = rng.Cells(1, 1).Column

For Each cl In rng
    If cl.Row < minRw Then minRw = cl.Row Else: If cl.Row > maxRw Then maxRw = cl.Row
    If cl.Column < minCl Then minCl = cl.Column Else: If cl.Column > maxCl Then maxCl = cl.Column
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
1 голос
/ 05 мая 2020

Вы можете l oop по областям и вести подсчет строк и столбцов, охваченных выделением. Использование двух словарей кажется излишним, но, похоже, это работает.

Если ваш диапазон состоит из нескольких несмежных областей, ваш код будет рассматривать только первый блок, например 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
...