📄 双向量本利分析.frm

📁 一个客车售票系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
      Exclusive       =   0   'False
      Height          =   375
      Left            =   150
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "日期车次"
      Top             =   1230
      Visible         =   0   'False
      Width           =   1815
   End
   Begin VB.Data Data2 
      Caption         =   "Data2"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   345
      Left            =   3270
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   630
      Visible         =   0   'False
      Width           =   1785
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   375
      Left            =   360
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   210
      Visible         =   0   'False
      Width           =   1815
   End
   Begin VB.Label Label27 
      BackStyle       =   0  'Transparent
      Height          =   180
      Left            =   6300
      TabIndex        =   12
      Top             =   5940
      Width           =   1080
   End
End
Attribute VB_Name = "双向量本利分析"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim cx() As Integer, Rs(20) As Integer, K As Integer, Kp As Integer
Dim Sr(20, 3) As Single, A1(20, 2) As Single, Cb(20, 3) As Single
Dim I As Integer, J As Integer, P As Integer, Datedata As String, CC As String
Private Sub Form_Load()
Dim Cxs As String, Cxtj1 As String, Cxtj2 As String
Dim Result As Integer, Temp As Integer
    Open App.Path + "\" + "Date.txt" For Input As #1
     Input #1, Datedata
    Close #1
    Open App.Path + "\" + "CC.txt" For Input As #2
     Input #2, CC
    Close #2
Data1.DatabaseName = App.Path + "\" + "班组统计.mdb"
Data2.DatabaseName = App.Path + "\" + "班组统计.mdb"
Data3.DatabaseName = App.Path + "\" + "班组统计.mdb"
Data4.DatabaseName = App.Path + "\" + "原始记录.mdb"
Data5.DatabaseName = App.Path + "\" + "原始记录.mdb"
Data6.DatabaseName = App.Path + "\" + "原始记录.mdb"
Data5.Refresh
Data6.Refresh
 Cxtj1 = "发车日期": Cxtj2 = "车次"
 Cxs = "[" + Cxtj1 + "] =" + "'" + Datedata + "'" + "And" + "[" + Cxtj2 + "] =" + "'" + CC + "'"
 Data4.RecordSource = "Select * From  日期车次  Where" & Cxs
 Data4.Refresh
 Data4.Recordset.Close
  Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Datedata + "'"
     Select Case Text4(3)
      Case "第一组"
       Data1.RecordSource = "Select * from B1 where" & Cxs
      Case "第二组"
       Data1.RecordSource = "Select * from B2 where" & Cxs
      Case "第三组"
       Data1.RecordSource = "Select * from B3 where" & Cxs
      Case "第四组"
       Data1.RecordSource = "Select * from B4 where" & Cxs
      Case "第五组"
       Data1.RecordSource = "Select * from B5 where" & Cxs
      Case "第六组"
       Data1.RecordSource = "Select * from B6 where" & Cxs
      Case "第七组"
       Data1.RecordSource = "Select * from B7 where" & Cxs
      Case "第八组"
       Data1.RecordSource = "Select * from B8 where" & Cxs
   End Select
 Data1.Refresh
 Data1.Recordset.MoveLast
 K = Data1.Recordset.RecordCount
 ReDim cx(K) As Integer
 Data1.Recordset.MoveFirst
 K = 0
  Do While Data1.Recordset.EOF = False
  K = K + 1
 cx(K) = Text1(2)
 Rs(cx(K)) = Text1(3)
 Data1.Recordset.MoveNext
Loop
Kp = K
  Data1.Recordset.Close
     Select Case Text4(3)
      Case "第一组"
       Data2.RecordSource = "Select * from J1 where" & Cxs
      Case "第二组"
       Data2.RecordSource = "Select * from J2 where" & Cxs
      Case "第三组"
       Data2.RecordSource = "Select * from J3 where" & Cxs
      Case "第四组"
       Data2.RecordSource = "Select * from J4 where" & Cxs
      Case "第五组"
       Data2.RecordSource = "Select * from J5 where" & Cxs
      Case "第六组"
       Data2.RecordSource = "Select * from J6 where" & Cxs
      Case "第七组"
       Data2.RecordSource = "Select * from J7 where" & Cxs
      Case "第八组"
       Data2.RecordSource = "Select * from J8 where" & Cxs
   End Select
 Data2.Refresh
 Data2.Recordset.MoveLast
 K = Data2.Recordset.RecordCount
 ReDim cx(K) As Integer
 Data2.Recordset.MoveFirst
 K = 0
 Do While Data2.Recordset.EOF = False
    K = K + 1
  cx(K) = Text2(2): Sr(cx(K), 1) = Text2(3): Sr(cx(K), 2) = Text2(4)
 Sr(cx(K), 3) = Val(Text2(5))
  A1(cx(K), 1) = Val(Text2(3)) + Val(Text2(4))
 Data2.Recordset.MoveNext
 Loop
 For I = 1 To K - 1
   For J = 1 To K - I
    If cx(J) > cx(J + 1) Then
     Temp = cx(J): cx(J) = cx(J + 1): cx(J + 1) = Temp
    End If
   Next J
 Next I
For P = 1 To K
    A1(cx(P), 2) = Val(Text6(1)) + Val(Text6(2)) + Val(Text6(3)) _
                 + Val(Text6(4)) + Val(Text6(5)) + Rs(cx(P)) * Val(Text6(6)) _
                 + Sr(cx(P), 3) * Val(Text6(7)) + A1(cx(P), 1) * Val(Text6(8))
    Cb(cx(P), 1) = Rs(cx(P)) * Val(Text6(6))
    Cb(cx(P), 2) = Sr(cx(P), 3) * Val(Text6(7))
    Cb(cx(P), 3) = A1(cx(P), 1) * Val(Text6(8))
Next P
 '如已有当前记录则做删除追加
 Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Datedata + "'"
    Select Case Text4(3)
      Case "第一组"
       Data3.RecordSource = "Select * from  C1  where" & Cxs
      Case "第二组"
       Data3.RecordSource = "Select * from  C2  where" & Cxs
      Case "第三组"
       Data3.RecordSource = "Select * from  C3  where" & Cxs
      Case "第四组"
       Data3.RecordSource = "Select * from  C4  where" & Cxs
      Case "第五组"
       Data3.RecordSource = "Select * from  C5  where" & Cxs
      Case "第六组"
       Data3.RecordSource = "Select * from  C6  where" & Cxs
      Case "第七组"
       Data3.RecordSource = "Select * from  C7  where" & Cxs
      Case "第八组"
       Data3.RecordSource = "Select * from  C8  where" & Cxs
   End Select
   Data3.Refresh
   If Text3(1) <> " " Then
     Do While Data3.Recordset.EOF = False
     Data3.Recordset.Delete
     Data3.Recordset.MoveNext
     Loop
    Data3.Recordset.AddNew
    For P = 1 To K
   Text3(1) = Datedata: Text3(2) = cx(P): Text3(3) = A1(cx(P), 2)
   Data3.Recordset.AddNew
   Next P
Else
     Select Case Text4(3)
      Case "第一组"
       Data3.RecordSource = "C1"
      Case "第二组"
       Data3.RecordSource = "C2"
      Case "第三组"
       Data3.RecordSource = "C3"
      Case "第四组"
       Data3.RecordSource = "C4"
      Case "第五组"
       Data3.RecordSource = "C5"
      Case "第六组"
       Data3.RecordSource = "C6"
      Case "第七组"
       Data3.RecordSource = "C7"
      Case "第八组"
       Data3.RecordSource = "C8"
   End Select
 Data3.Refresh
    Data3.Recordset.AddNew
For P = 1 To K
   Text3(1) = Datedata: Text3(2) = cx(P): Text3(3) = A1(cx(P), 2)
    Data3.Recordset.AddNew
 Next P
End If

Datedata = Format(CDate(Datedata) + 2, "yyyy年m月d日")
  Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Datedata + "'"
     Select Case Text4(3)
      Case "第一组"
       Data1.RecordSource = "Select * from B1 where" & Cxs
      Case "第二组"
       Data1.RecordSource = "Select * from B2 where" & Cxs
      Case "第三组"
       Data1.RecordSource = "Select * from B3 where" & Cxs
      Case "第四组"
       Data1.RecordSource = "Select * from B4 where" & Cxs
      Case "第五组"
       Data1.RecordSource = "Select * from B5 where" & Cxs
      Case "第六组"
       Data1.RecordSource = "Select * from B6 where" & Cxs
      Case "第七组"
       Data1.RecordSource = "Select * from B7 where" & Cxs
      Case "第八组"
       Data1.RecordSource = "Select * from B8 where" & Cxs
   End Select
 Data1.Refresh
 Data1.Recordset.MoveLast
 K = Data1.Recordset.RecordCount
 ReDim cx(K) As Integer
 Data1.Recordset.MoveFirst
 K = 0
  Do While Data1.Recordset.EOF = False
  K = K + 1
 cx(K) = Text1(2)
 Rs(cx(K)) = Text1(3)
 Data1.Recordset.MoveNext
Loop
Kp = K
  Data1.Recordset.Close
     Select Case Text4(3)
      Case "第一组"
       Data2.RecordSource = "Select * from J1 where" & Cxs
      Case "第二组"
       Data2.RecordSource = "Select * from J2 where" & Cxs
      Case "第三组"
       Data2.RecordSource = "Select * from J3 where" & Cxs
      Case "第四组"
       Data2.RecordSource = "Select * from J4 where" & Cxs
      Case "第五组"
       Data2.RecordSource = "Select * from J5 where" & Cxs
      Case "第六组"
       Data2.RecordSource = "Select * from J6 where" & Cxs
      Case "第七组"
       Data2.RecordSource = "Select * from J7 where" & Cxs
      Case "第八组"
       Data2.RecordSource = "Select * from J8 where" & Cxs
   End Select
 Data2.Refresh
 Data2.Recordset.MoveLast
 K = Data2.Recordset.RecordCount
 ReDim cx(K) As Integer
 Data2.Recordset.MoveFirst
 K = 0
 Do While Data2.Recordset.EOF = False
    K = K + 1
  cx(K) = Text2(2): Sr(cx(K), 1) = Text2(3): Sr(cx(K), 2) = Text2(4)
 Sr(cx(K), 3) = Val(Text2(5))
  A1(cx(K), 1) = Val(Text2(3)) + Val(Text2(4))
 Data2.Recordset.MoveNext
 Loop
 For I = 1 To K - 1
   For J = 1 To K - I
    If cx(J) > cx(J + 1) Then
     Temp = cx(J): cx(J) = cx(J + 1): cx(J + 1) = Temp
    End If
   Next J
 Next I
For P = 1 To K
    A1(cx(P), 2) = Val(Text6(1)) + Val(Text6(2)) + Val(Text6(3)) _
                 + Val(Text6(4)) + Val(Text6(5)) + Rs(cx(P)) * Val(Text6(6)) _
                 + Sr(cx(P), 3) * Val(Text6(7)) + A1(cx(P), 1) * Val(Text6(8))
    Cb(cx(P), 1) = Rs(cx(P)) * Val(Text6(6))
    Cb(cx(P), 2) = Sr(cx(P), 3) * Val(Text6(7))
    Cb(cx(P), 3) = A1(cx(P), 1) * Val(Text6(8))
Next P
 '如已有当前记录则做删除追加
 Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Datedata + "'"
    Select Case Text4(3)
      Case "第一组"
       Data3.RecordSource = "Select * from  C1  where" & Cxs
      Case "第二组"
       Data3.RecordSource = "Select * from  C2  where" & Cxs
      Case "第三组"
       Data3.RecordSource = "Select * from  C3  where" & Cxs
      Case "第四组"
       Data3.RecordSource = "Select * from  C4  where" & Cxs
      Case "第五组"
       Data3.RecordSource = "Select * from  C5  where" & Cxs
      Case "第六组"
       Data3.RecordSource = "Select * from  C6  where" & Cxs
      Case "第七组"
       Data3.RecordSource = "Select * from  C7  where" & Cxs
      Case "第八组"
       Data3.RecordSource = "Select * from  C8  where" & Cxs
   End Select
   Data3.Refresh
   If Text3(1) <> " " Then
     Do While Data3.Recordset.EOF = False
     Data3.Recordset.Delete
     Data3.Recordset.MoveNext
     Loop
    Data3.Recordset.AddNew
    For P = 1 To K
   Text3(1) = Datedata: Text3(2) = cx(P): Text3(3) = A1(cx(P), 2)
   Data3.Recordset.AddNew
   Next P
Else
     Select Case Text4(3)
      Case "第一组"
       Data3.RecordSource = "C1"
      Case "第二组"
       Data3.RecordSource = "C2"
      Case "第三组"
       Data3.RecordSource = "C3"
      Case "第四组"
       Data3.RecordSource = "C4"
      Case "第五组"
       Data3.RecordSource = "C5"
      Case "第六组"
       Data3.RecordSource = "C6"
      Case "第七组"
       Data3.RecordSource = "C7"
      Case "第八组"
       Data3.RecordSource = "C8"
   End Select
 Data3.Refresh
    Data3.Recordset.AddNew
For P = 1 To K
   Text3(1) = Datedata: Text3(2) = cx(P): Text3(3) = A1(cx(P), 2)
    Data3.Recordset.AddNew
 Next P
End If

  Unload Me
End Sub
Private Sub TotalData()
Dim Ta1 As Currency, Ta2 As Currency, Ta3 As Currency
Dim Tb1 As Currency, Tb2 As Currency
Dim Tc1 As Single, Tc2 As Single, Tc3 As Single
Dim Tc4 As Single, Tc5 As Single, Tc6 As Single
Dim Tc7 As Single, Tc8 As Single, Tc9 As Currency
 Label40 = "车厢： 全车"
For P = 1 To K
Ta1 = Ta1 + A1(cx(P), 1): Ta2 = Ta2 + A1(cx(P), 2)
Select Case cx(P)
  Case 3, 4, 5, 6, 7, 8, 9
   Ta3 = Ta3 + Text5(2)
  Case 10
   Ta3 = Ta3 + Text5(1)
  Case Else
   Ta3 = Ta3 + Text5(3)
End Select
Tb1 = Tb1 + Sr(cx(P), 1): Tb2 = Tb2 + Sr(cx(P), 2)
Tc1 = Tc1 + Val(Text6(1)): Tc2 = Tc2 + Val(Text6(2)): Tc3 = Tc3 + Val(Text6(3))
Tc4 = Tc4 + Val(Text6(4)): Tc5 = Tc5 + Val(Text6(5)): Tc6 = Tc6 + Rs(cx(P)) * Val(Text6(6))
Tc7 = Tc7 + Sr(cx(P), 3) * Val(Text6(7)): Tc8 = Tc8 + A1(cx(P), 1) * Val(Text6(8))
Next
Tc9 = Tc1 + Tc2 + Tc1 + Tc3 + Tc4 + Tc5 + Tc6 + Tc7 + Tc8
'单车量本利分析表
 Label9 = Int(Ta1)
 Label10 = Int(Ta2)
 Label11 = Int(Ta1 - Ta2)
 Label12 = Int(Ta3)
'单车收入表
Label17 = Int(Tb1)
Label18 = Int(Tb2)
Label19 = Int(Tb1 + Tb2)
'单车成本表
Label30 = Int(Tc1)
Label31 = Int(Tc2)
Label32 = Int(Tc3)
Label33 = Int(Tc4)
Label34 = Int(Tc5)
Label35 = Int(Tc6)
Label36 = Int(Tc7)
Label37 = Int(Tc8)
Label38 = Int(Tc9)
End Sub

Private Sub Label36_Click()

End Sub
上一页 12
💿 文件大小 1252 K
👤 上传用户 zzxt
📂 所属分类压缩解压
🏷️ 相关标签

#售票系统
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -