检查是否选择了多个单元格

Question

我想知道如何检查一个范围内是否选择了多个单元格？

我有 3 个单元格，我想检查范围是“A:B”和“D”，我正在尝试此代码，但它对我不起作用。

If 3 - CountA(range) < 1 Then

我怎样才能用其他方式做到这一点？

Answer 1

对于选定的范围，类似这样的事情：

If 3-Selection.Cells.Count < 1 then

或者，如果您有可能选择了很多单元格，请使用这个：

If 3-Selection.Cells.Countlarge < 1 Then

Answer 2

如果您使用

Worksheet_Change(ByVal Target As Range)

或

Worksheet_SelectionChange(ByVal Target As Range)

，请使用以下代码：

If InStr(Target.Address, ":") > 0 Or InStr(Target.Address, ",") > 0 Or InStr(Target.Address, ";") > 0 Then

这将检查所选范围是否例如：

`A1;C1` (Cells A1 and C1 are selected) or
`E1:E4` (E1 to E4 are selected)

有时使用

";"

，有时使用

","

，以便我们同时检查它们。

您可以使用您在代码中定义的范围来代替

Target

，例如：

If InStr(MyRange.Address, ":") > 0 Or InStr(MyRange.Address, ",") > 0 Or InStr(MyRange.Address, ";") > 0 Then

Answer 3

我想你想尝试一些类似的事情

Dim rng1 As Range
Set rng1 = Range("A1:B1,D1")
MsgBox 3 - rng1.Cells.Count

Answer 4

 Dim SelectedRng As Range, SelectedRngStr As String
 Set SelectedRng = Range(Target.Address) ' Or Range("A1:A2"), whatever
 If SelectedRng.Cells.Count = 1 Then
  SelectedRngStr = SelectedRng.Value
 Else
  Debug.Print "SelectedRng.Cells.Count = " & SelectedRng.Cells.Count
 End If

Answer 5

我使用@FreeSoftwareServers 和@KazimierzJawor 的答案的修改组合来完成军事字母宏。如果你喜欢我分享的内容，请给他们点个赞。我只是分享以防万一它可以帮助某人了解如何在子例程中使用它（我确实必须修改它）并为读者提供额外的军事字母子。

Sub Military_Alphabet_MSG()

'''''                   Check if more than one cell is selected
    Dim SelectedRng As Range, Cell As Range, S$, s2$
    Set SelectedRng = Range(Selection.Address) ' Or Range("A1:A2"), whatever
    If SelectedRng.Cells.CountLarge > 1 Then
        MsgBox "More than one cell is selected.  Select one cell and try again.", vbCritical, "ERROR!"
        Exit Sub
    Else
        Set Cell = ActiveCell
        S = UCase(Cell.Value)
    End If

'''''                   Create dictionary with military alphabet (Microsoft Scripting Runtime reference required)
    Dim milDict As Scripting.Dictionary
    Set milDict = New Scripting.Dictionary
        milDict("A") = "Alpha"
        milDict("B") = "Bravo"
        milDict("C") = "Charlie"
        milDict("D") = "Delta"
        milDict("E") = "Echo"
        milDict("F") = "Foxtrot"
        milDict("G") = "Golf"
        milDict("H") = "Hotel"
        milDict("I") = "India"
        milDict("J") = "Juliet"
        milDict("K") = "Kilo"
        milDict("L") = "Lima"
        milDict("M") = "Mike"
        milDict("N") = "November"
        milDict("O") = "Oscar"
        milDict("P") = "Papa"
        milDict("Q") = "Quebec"
        milDict("R") = "Romeo"
        milDict("S") = "Sierra"
        milDict("T") = "Tango"
        milDict("U") = "Uniform"
        milDict("V") = "Victor"
        milDict("W") = "Whiskey"
        milDict("X") = "X-Ray"
        milDict("Y") = "Yankee"
        milDict("Z") = "Zulu"
        milDict("1") = "One"
        milDict("2") = "Two"
        milDict("3") = "Three"
        milDict("4") = "Four"
        milDict("5") = "Five"
        milDict("6") = "Six"
        milDict("7") = "Seven"
        milDict("8") = "Eight"
        milDict("9") = "Niner"
        milDict("0") = "Zero"
        milDict("@") = "@AT@"
        milDict("-") = "-DASH-"
        milDict(".") = ".DOT."

'''''                   Unused section demonstrating how to loop through keys
'    Dim key As Variant
'    For Each key In milDict.Keys
'        Debug.Print key, milDict(key)
'    Next key

'''''                   Create First Part of ReturnString
    Dim ReturnString$
    ReturnString = "(" & Chr(34)
    If milDict.Exists(Left(S, 1)) Then
        ReturnString = ReturnString & milDict(Left(S, 1))
    Else
        ReturnString = Left(S, 1)
    End If
    
'''''                   Create the rest of ReturnString
    If Len(S) > 1 Then
        For i = 2 To Len(S)
            s2 = Mid(S, i, 1)
            If milDict.Exists(s2) Then
                ReturnString = ReturnString & Chr(34) & ", " & Chr(34) & milDict(s2)
            Else
                ReturnString = ReturnString & ", " & Chr(34) & s2
            End If
        Next i
    End If
    ReturnString = ReturnString & Chr(34) & ")"
    

'''''                   Add to clipboard
    Dim objData As New MSForms.DataObject  '"Microsoft Forms 2.0 Object Library" (or later) must be enabled per user before DataObject may be utilized
    objData.SetText ReturnString
    objData.PutInClipboard
    
'''''                   Display Informational MsgBox
    MsgBox Cell.Value & Chr(10) & Chr(10) & ReturnString & Chr(10) & Chr(10) & "Conversion has been placed in your clipboard.", vbOKOnly + vbInformation, "Military Alphabet Conversion"
End Sub