VBA写一个下拉复选框，以及循环判断，附代码

VBA写一个下拉复选框，以及循环判断，附代码

图1：

图2

图2中的复选下拉框框显示图1中的配置。

VBA代码

Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim i&, s$
    With ListBox2
        For i = 0 To .ListCount - 1
            If .Selected(i) Then s = s & "," & .List(i)
        Next
        .TopLeftCell.Offset(, -1).Value = Mid(s, 2)
        .Visible = False
    End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Row > 2 And Target.Column = 4 Then
        
         arr = Sheets("码表").Range("C2:C5")
         
        With ListBox1
            .MultiSelect = 1
            .ListStyle = 1

            .List = Sheets("码表").Range("C2:C5").Value
            .Top = Target.Top
            .Left = Target.Left + Target.Width
            .Height = Target.Height * 5
            .Width = 90
            .Visible = True
        End With
    Else
        ListBox1.Visible = False
    End If
    
     If Target.Row > 2 And Target.Column = 8 Then
        
        Dim a
        a = "C7:C" + CStr(Worksheets(2).[C65536].End(xlUp).Row)
        
        arr = Sheets("码表").Range(a)
        
        
        With ListBox2
            .MultiSelect = 1
            .ListStyle = 1

            .List = Sheets("码表").Range(a).Value
            .Top = Target.Top
            .Left = Target.Left + Target.Width
            .Height = Target.Height * 5
            .Width = 90
            .Visible = True
        End With
    Else
        ListBox2.Visible = False
    End If
End Sub
        
        
        
        
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If ListBox1.ListIndex = -1 Then Exit Sub
    Dim i&, s$
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then s = s & "," & .List(i)
        Next
        .TopLeftCell.Offset(, -1).Value = Mid(s, 2)
        .Visible = False
    End With
End Sub



Sub pinJson()  'a是个函数名字，可以随意定义
    Dim str
    Dim i, j
    i = 4
    j = 1
    str = "{"
    Dim m As Integer
    For r = 4 To Worksheets(1).[C65536].End(xlUp).Row
    '读取节点号
         str = str + """" + Worksheets(1).Cells(r, 3).Value + """" + ":{" + """result""" + ":{" + """show""" + ":true," + ""
         '配置options,先循环一遍找到每个审批结果的英文
         str = str + """" + "options" + """" + ":["
         
        Dim options As Variant
        options = VBA.Split(Worksheets(1).Cells(r, 4).Value, ",")
        
        Dim n As Integer
        Dim a As Integer
        For n = LBound(options) To UBound(options)
            '读取码表中的审批结果码值
            For a = 1 To Worksheets(2).[C65536].End(xlUp).Row
             '循环每个码值获取码值项
                If (Worksheets(2).Cells(a, 3).Value = options(n)) Then
                    str = str + "{" + """" + "label" + """" + ":" + """" + options(n) + """" + "," + """" + "name" + """" + ":" + """" + Worksheets(2).Cells(a, 2).Value + """" + "},"
                End If
                Next a
        Next n
        '去掉最后的逗号加闭环,如果最后一个是逗号
        Do While str Like "*,"
             str = Left(str, Len(str) - 1)
         Loop
         str = str + "]},"
         
        '读取展示的模块(通过，拒绝，退件，撤单)
        Dim arrResult As Variant
        arrResult = VBA.Split(Worksheets(1).Cells(r, 4).Value, ",")
        
        For m = LBound(arrResult) To UBound(arrResult)
        If (arrResult(m) = "通过") Then
        '读取通过下的配置内容
            If (Worksheets(1).Cells(r, 5).Value = "√") Then
                str = str + """" + "amount" + """" + ":{" + """" + "show" + """" + ": true },"
            Else
                str = str + """" + "amount" + """" + ":{" + """" + "show" + """" + ": false },"
            End If
            
        ElseIf (arrResult(m) = "拒绝") Then
        '读取拒绝下的配置内容
            If (Worksheets(1).Cells(r, 6).Value = "√") Then
                str = str + """" + "cause" + """" + ":{" + """" + "show" + """" + ": true },"
            Else
                str = str + """" + "cause" + """" + ":{" + """" + "show" + """" + ": false },"
            End If
        ElseIf (arrResult(m) = "退件") Then
        '读取退件下的配置内容
            If (Worksheets(1).Cells(r, 7).Value = "√") Then
                str = str + """" + "returnReason" + """" + ":{" + """" + "show" + """" + ": true },"
            Else
                str = str + """" + "returnReason" + """" + ":{" + """" + "show" + """" + ": false },"
            End If
            
            If (Worksheets(1).Cells(r, 8).Value <> "") Then
                str = str + """" + "backFlowId" + """" + ":{" + """" + "show" + """" + ": true ,"
                 str = str + """" + "options" + """" + ":["
                '拼退件节点
                 Dim jiedian As Variant
                jiedian = VBA.Split(Worksheets(1).Cells(r, 8).Value, ",")
                
                Dim b As Integer
                Dim c As Integer
                For b = LBound(jiedian) To UBound(jiedian)
                    '读取码表中的节点的码值
                    For c = 1 To Worksheets(2).[C65536].End(xlUp).Row
                 '循环每个码值获取码值项
                If (Worksheets(2).Cells(c, 3).Value = jiedian(b)) Then
                    str = str + "{" + """" + "label" + """" + ":" + """" + jiedian(b) + """" + "," + """" + "name" + """" + ":" + """" + Worksheets(2).Cells(c, 2).Value + """" + "},"
                End If
                Next c
            Next b
                 '去掉最后的逗号加闭环,如果最后一个是逗号
            Do While str Like "*,"
                 str = Left(str, Len(str) - 1)
             Loop
             str = str + "]},"
                
            Else
                str = str + """" + "backFlowId" + """" + ":{" + """" + "show" + """" + ": false },"
            End If
        Else
        '读取撤单下的配置内容
            If (Worksheets(1).Cells(r, 9).Value = "√") Then
                str = str + """" + "cancelReason" + """" + ":{" + """" + "show" + """" + ": true },"
            Else
                str = str + """" + "cancelReason" + """" + ":{" + """" + "show" + """" + ": false },"
            End If
        End If
        Debug.Print Trim(arrResult(m))
          Next m
          
          '读取其他审批意见下的配置内容
            If (Worksheets(1).Cells(r, 10).Value = "√") Then
                str = str + """" + "isReduceAmount" + """" + ":{" + """" + "show" + """" + ": true },"
            Else
                str = str + """" + "isReduceAmount" + """" + ":{" + """" + "show" + """" + ": false },"
            End If
              If (Worksheets(1).Cells(r, 11).Value = "√") Then
                str = str + """" + "reduceAmountCause" + """" + ":{" + """" + "show" + """" + ": true },"
            Else
                str = str + """" + "reduceAmountCause" + """" + ":{" + """" + "show" + """" + ": false },"
            End If
              If (Worksheets(1).Cells(r, 12).Value = "√") Then
                str = str + """" + "content" + """" + ":{" + """" + "show" + """" + ": true },"
            Else
                str = str + """" + "content" + """" + ":{" + """" + "show" + """" + ": false },"
            End If
            If (Worksheets(1).Cells(r, 12).Value = "√") Then
                str = str + """" + "auditRemark" + """" + ":{" + """" + "show" + """" + ": true },"
            Else
                str = str + """" + "auditRemark" + """" + ":{" + """" + "show" + """" + ": false },"
            End If
          
          '去掉最后的逗号加闭环,如果最后一个是逗号
            Do While str Like "*,"
                 str = Left(str, Len(str) - 1)
             Loop
             str = str + "},"
    Next
     '去掉最后的逗号加闭环,如果最后一个是逗号
        Do While str Like "*,"
             str = Left(str, Len(str) - 1)
         Loop
         str = str + "}"
ThisWorkbook.Sheets(1).Cells(1, 1) = str
 'ThisWorkbook 代表这个工作簿，sheets(1)代表第一个sheet Cells(1, 1）代表第一行第一列，
'整句意思就是在工作簿的SHEET1上的第一行第一列设置值为 这是我的第一个代码
 
End Sub

excel下载链接：（会员可以免费下载，如果需要可以联系我发给你，提供邮箱）
//download.csdn.net/download/liuhongya328/11986998