如何给option button分组，使得用户在选择是或者否的时候，可以二选一或者三选一，而且各个选项之间互不干扰呢。方法非常简单，只要使用groupname设置一下分组就可以了。



这里设置一下分组后，同个分组的option button就只能选择一个了，非常方便。

GroupName可以是数字也可以是英文，大家可以酌情取名。

'单选按钮属性

Sub attribute1()

Sheet2.OptionButton1.Caption = "男"

Sheet2.OptionButton2.Caption = "女"

End Sub

Sub attribute2()

Sheet2.OptionButton1.Enabled = True

Sheet2.OptionButton2.Enabled = True

End Sub

'组名

Sub attribute3()

Sheet2.OptionButton1.GroupName = "性别"

Sheet2.OptionButton2.GroupName = "性别"

End Sub

'返回值

Sub attribute4()

Sheet2.Range("A1") = Sheet2.OptionButton1.Value

Sheet2.Range("b1") = Sheet2.OptionButton2.Value

End Sub

 

SUB TEST()
    Dim i As Integer
    Dim s As String '存储生成的代码
    Dim f As String '保存的文件名
    Dim rng As Range
    f = ThisWorkbook.Path & "\GZ.kml"
    s = "<kml xmlns=""http://earth.google.com/kml/2.0"">" & Chr(13) & _
        "<Folder>"
    'Set rng = Intersect(Selection, ActiveSheet.UsedRange)
    x = Application.CountA(Worksheets("结果").Range("A:A"))
    Set rng = Worksheets("结果").[A1].CurrentRegion
    If rng Is Nothing Then MsgBox "请选择合适的数据信息!": Exit Sub
    For i = 1 To x
            s = s & "<Placemark><description></description><name>" & rng(i, 1).Value & _
                    " </name><LookAt>" & _
                    "<longitude>" & rng(i, 2).Value & "</longitude>" & _
                    "<latitude>" & rng(i, 3).Value & "</latitude>" & _
                    "<range>2000</range>" & _
                    "<tilt>0</tilt>" & _
                    "<heading>3</heading>" & _
                    "</LookAt><Point>" & _
                    "<coordinates>" & rng(i, 2).Value & "," & rng(i, 3) & ",0</coordinates>" & _
                    "</Point> </Placemark>" & Chr(13)
    Next
    s = s & Chr(13) & "</Folder></kml>"
    
    SaveFile s, f ' 件，则中文名可以正常显示
    FileZM f, "GB2312", f, "UTF-8"   '转换成UTF-8编码的文件
    MsgBox "已生成！"
    END SUB

Public batch$
Sub crAddReport()
    '获取窗体单选框选择
    UserForm1.Show
    If UserForm1.OptionButton1.Value = True Then
        batch = "一"
    ElseIf UserForm1.OptionButton2.Value = True Then
        batch = "二"
    ElseIf UserForm1.OptionButton3.Value = True Then
        batch = "三"
    End If

    t1 = Timer
    Application.ScreenUpdating = False
        Call importLog '引用模块2的方法
        Call findBrokenStation '引用模块2的方法
        Call nowCrReport2
        Call crFile2
    Application.ScreenUpdating = True
    t2 = Timer
    MsgBox "己完成，运行时间 = " & (t2 - t1) * 1000 & " ms"

End Sub

Sub crFile2()

    Worksheets("结果统计-新增").Copy
    With ActiveSheet
        .Select
        .Columns("A:E").Delete
        .Shapes.Range(Array("Picture 1")).Delete
        [I1] = "执行结果"
        [I2] = "断X"
        [I3] = "配齐4个XX"
        [I4] = "无XX数据"
        [I5] = "因XXXX未配齐"
        [I6] = "总计"

        [J1] = "数量"
        [J2].formula = "=COUNTIF(E:E,I2)"
        [J3].formula = "=COUNTIF(E:E,I3)"
        [J4].formula = "=COUNTIF(E:E,I4)"
        [J5].formula = "=COUNTIF(E:E,I5)"
        [J6].formula = "=SUM(J2:J5)"
    End With
    '格式化
    Call formatting2
    '选择批次
    
    ActiveWorkbook.SaveAs "XXX测量配置结果_" & Month(Date) & "月第" & batch & "组.xlsx"
    
End Sub

Sub nowCrReport2()
    Application.ScreenUpdating = False
    Dim d As Object, rng As Range
    Set dCity = CreateObject("Scripting.Dictionary")
    Set dOSS = CreateObject("Scripting.Dictionary")
    With Worksheets("ip对应地市名工具")
    For i = 1 To .[A65536].End(xlUp).Row
        dCity.add .Cells(i, 1).Value, .Cells(i, 2).Value
        dOSS.add .Cells(i, 1).Value, .Cells(i, 3).Value
    Next
    End With
    
    Dim lRow%, leftIp$, cellsNum, freqNum%
    lRow = [A65536].End(xlUp).Row
    On Error Resume Next
    For i = 2 To lRow
        '如果Cells(i, 1).Value为空，则对应行不作处理，也为空
        If Cells(i, 1).Value <> "" Then
            leftIp = Left(Cells(i, 1).Value, 6)
            Cells(i, 6) = dCity(leftIp)
            Cells(i, 7) = Cells(i, 2) '名称
            Cells(i, 8) = Cells(i, 1) 'IP
            Cells(i, 9) = dOSS(leftIp)
            cellsNum = Cells(i, 4).Value
            freqNum = Cells(i, 5).Value
            Cells(i, 10) = addResult(cellsNum, freqNum)
            Cells(i, 11) = Cells(i, 4).Value
            Cells(i, 12) = Cells(i, 5).Value
        End If
    Next
    '此处妙，多重功能：删除A列空行，不正确IP，8.137站点
    Columns("F:F").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True
    
End Sub

Function addResult(cellsNum, freqNum)
    
    If cellsNum = "" Then
        addResult = "断X"
    ElseIf cellsNum = 0 Then
        addResult = "无XX数据"
    ElseIf freqNum / cellsNum = 4 Then
        addResult = "配齐4个XX"
    Else
        addResult = "因占用XX未配齐"
    End If

End Function

Sub formatting2()
'    置中，加边框，上色
    Range("I1:J6").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("I1:J1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("I6:J6").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Rows("2:6").Select
    Selection.RowHeight = 21

    Columns("I:J").Select
    Selection.ColumnWidth = 17.88

End Sub