玖叶教程网

???本文于2023年5月8日首发于本人同名公众号：Excel活学活用，更多文章敬请关注！

☆本期内容概要☆

• 中医诊所收费系统：收银报表模块代码

Dim DicDate
Dim arrDetail()
Private Sub cb_Cancle_Click()
Unload Me
Call BackTo
End Sub
Private Sub CmbDate_Change()
    Dim DicColType
    Dim iLable As Control, sLable As Control
     Dim arrColType(), arrColAmount()
    Dim iSum As Single
    iSum = 0
     For Each ILabel In Controls
        If ILabel.Name Like "aLb_*" Then Controls.Remove ILabel.Name
    Next
     Set DicColType = CreateObject("Scripting.Dictionary")
     DicColType("合计") = 0
    If Me.LstDetail.ListCount > 1 Then
        For i = Me.LstDetail.ListCount - 1 To 1 Step -1
            Me.LstDetail.RemoveItem i
        Next
    End If
    For i = 1 To UBound(arrDetail, 1)
        If arrDetail(i, 2) = Me.CmbDate.Text Then
            Me.LstDetail.AddItem
            Me.LstDetail.List(Me.LstDetail.ListCount - 1, 0) = arrDetail(i, 1)
            For j = 3 To UBound(arrDetail, 2)
                Me.LstDetail.List(Me.LstDetail.ListCount - 1, j - 2) = arrDetail(i, j)
            Next
        End If
    Next
    
    For i = 1 To Me.LstDetail.ListCount - 1
        iSum = iSum + Val(Me.LstDetail.List(i, 8))
        DicColType(Me.LstDetail.List(i, 7)) = DicColType(Me.LstDetail.List(i, 7)) + Val(Me.LstDetail.List(i, 8))
    Next
    DicColType("合计") = iSum
    arrColType = DicColType.keys
    arrColAmount = DicColType.items
    With Usf_CashReport
         For i = DicColType.Count - 1 To 0 Step -1
             Set iLable = .Controls.Add("Forms.Label.1", "aLb_" & i, True)
            With iLable
                .Caption = arrColType(i)
                .Left = 100 - (1 - i) * 80
                .Top = 95
                .Width = 80
                .TextAlign = fmTextAlignCenter
                .FontSize = 10
                .FontName = "微软雅黑"
                If .Caption = "合计" Then
                    .Font.Bold = True
                End If
                .ForeColor = RGB(50, 50, 255)
            End With
        Next
    End With
    With Usf_CashReport
         For i = DicColType.Count - 1 To 0 Step -1
            Set sLable = .Controls.Add("Forms.Label.1", "aLb_A" & i, True)
            With sLable
                .Caption = Format(arrColAmount(i), "standard")
                .Left = 100 - (1 - i) * 80
                .Top = 120
                .Width = 80
                .TextAlign = fmTextAlignCenter
                .FontSize = 10
                  .FontName = "微软雅黑"
                If arrColType(i) = "合计" Then
                    .Font.Bold = True
                End If
                .ForeColor = RGB(150, 0, 0)
             End With
        Next
    End With
End Sub


Private Sub CmbMonth_Change()
    DicDate.RemoveAll
    Set DicDate = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arrDetail, 1)
        If VBA.InStr(1, arrDetail(i, 1), Me.CmbMonth) > 0 Then
            DicDate(arrDetail(i, 2)) = 1
        End If
    Next
    Me.CmbDate.List = DicDate.keys
    Me.CmbDate.Text = Me.CmbDate.List(DicDate.Count - 1)
End Sub
Private Sub UserForm_Activate()
    Dim iMonth As String
    Set DicMonth = CreateObject("Scripting.Dictionary")
    Set DicDate = CreateObject("Scripting.Dictionary")
    
    arrDetail = Sheet4.Range("A2:K" & Sheet4.UsedRange.Rows.Count).Value '收入明细表
    For i = 1 To UBound(arrDetail, 1)
        iMonth = Right(Left(arrDetail(i, 1), 7), 6)
        DicMonth(iMonth) = DicMonth(iMonth) + 1
        DicDate(arrDetail(i, 2)) = DicDate(arrDetail(i, 2)) + arrDetail(i, 10)
    Next
    Me.CmbMonth.List = DicMonth.keys
    Me.CmbMonth.Text = Me.CmbMonth.List(Me.CmbMonth.ListCount - 1)
    Me.CmbDate.List = DicDate.keys
    Me.CmbDate.Text = Me.CmbDate.List(Me.CmbDate.ListCount - 1)
     Me.LstDetail.ColumnWidths = "80;45;45;70;45; 120;45;60;40;150"
    Me.LstDetail.AddItem
    Me.LstDetail.List(0, 0) = "单号"
    Me.LstDetail.List(0, 1) = "客户"
    Me.LstDetail.List(0, 2) = "介绍人"
    Me.LstDetail.List(0, 3) = "科室"
    Me.LstDetail.List(0, 4) = "主治医师"
    Me.LstDetail.List(0, 5) = "收费项目"
    Me.LstDetail.List(0, 6) = "收款人"
    Me.LstDetail.List(0, 7) = "收款方式"
    Me.LstDetail.List(0, 8) = "金额"
    Me.LstDetail.List(0, 9) = "备注"
    
     If Me.LstDetail.ListCount > 1 Then
        For i = Me.LstDetail.ListCount - 1 To 1 Step -1
            Me.LstDetail.RemoveItem i
        Next
    End If
      Call CmbDate_Change
 End Sub

☆猜你喜欢☆

????本文于2023年5月8日首发于本人同名公众号：Excel活学活用，更多文章敬请关注！