📄 数据统计.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "数据统计"
ClientHeight = 2610
ClientLeft = 5265
ClientTop = 4575
ClientWidth = 5175
Icon = "数据统计.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2610
ScaleMode = 0 'User
ScaleWidth = 4259.259
ShowInTaskbar = 0 'False
Begin VB.CommandButton Command3
Caption = "开始处理"
Enabled = 0 'False
Height = 375
Left = 3960
TabIndex = 12
Top = 600
Width = 1095
End
Begin MSComctlLib.ProgressBar zjd
Height = 180
Left = 840
TabIndex = 7
Top = 1680
Width = 3615
_ExtentX = 6376
_ExtentY = 318
_Version = 393216
Appearance = 1
End
Begin MSComctlLib.ProgressBar dxjd
Height = 180
Left = 840
TabIndex = 6
Top = 1320
Width = 3615
_ExtentX = 6376
_ExtentY = 318
_Version = 393216
Appearance = 1
End
Begin VB.CheckBox Check1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2280
TabIndex = 5
Top = 570
Width = 243
End
Begin VB.TextBox Text2
Alignment = 2 'Center
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 315
Left = 1080
TabIndex = 3
Text = "深层数据"
Top = 600
Width = 1094
End
Begin VB.CommandButton Command2
Caption = "退出 &Q"
Height = 375
Left = 4200
TabIndex = 2
Top = 2160
Width = 855
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4440
Top = 2640
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command1
Caption = "..."
Enabled = 0 'False
BeginProperty Font
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4680
TabIndex = 1
Top = 120
Width = 375
End
Begin VB.TextBox Text1
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000080FF&
Height = 375
Left = 120
TabIndex = 0
Top = 120
Width = 4575
End
Begin VB.Label Label6
AutoSize = -1 'True
Height = 180
Left = 4560
TabIndex = 11
Top = 1680
Width = 90
End
Begin VB.Label Label5
AutoSize = -1 'True
Height = 180
Left = 4560
TabIndex = 10
Top = 1320
Width = 90
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "总进度"
Height = 180
Left = 115
TabIndex = 9
Top = 1680
Width = 540
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "当前进度"
Height = 180
Left = 115
TabIndex = 8
Top = 1320
Width = 720
End
Begin VB.Label Label1
Caption = "数据类型："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 4
Top = 650
Width = 1095
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim fil As File
Dim ts As TextStream
Private Sub Check1_Click()
Text2.Enabled = False
Command1.Enabled = True
End Sub
Private Sub Command1_Click()
'**************选择数据库文件************
Command1.Enabled = False
CommonDialog1.CancelError = True
On Error GoTo ERRHANDLER
Dim sFile As String
CommonDialog1.Filter = "Microsoft Access Databases |*.MDB|All Files | *.*"
CommonDialog1.FilterIndex = 1
CommonDialog1.ShowOpen
If Len(CommonDialog1.FileName) Then
Text1.Text = CommonDialog1.FileName
zjd.Value = 0
dxjd.Value = 0
Label5.Caption = "0.0%"
Label6.Caption = "0.0%"
Command3.Enabled = True
End If
ERRHANDLER:
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub dataEDIT(DB As Database, STABLE As String, sField As String, fso As FileSystemObject, sFile As String)
'**************打开表&字段************
Dim RS As Recordset
Dim lstrSQL As String
Dim Dcount As Integer
Dim TempData(2, 10000) As Double
Dim dbname As String
Dim str As String
Dim FV(14) As String
Dim tt As Integer
Dim Avg, s, ss, cv, Dsum As Double
Dim k, n, m, i, j As Integer
On Error GoTo rUNeRR
lstrSQL = ""
lstrSQL = lstrSQL & " Select " & STABLE & "." & sField
lstrSQL = lstrSQL & " From " & STABLE
lstrSQL = lstrSQL & " Order By " & STABLE & "." & sField
Set RS = DB.OpenRecordset(lstrSQL, dbOpenSnapshot)
lstrSQL = ""
RS.MoveFirst
'**************打开表&字段************
'**************数据插入内存************
Dcount = RS.RecordCount
FV(14) = Dcount '记录原始记录数量
If FV(14) < 2 Then
MsgBox "统计数据对象记录数为: " & FV(14) & Chr(10) & Chr(13) & " 不满足统计条件,当前统计对象将被忽略"
Exit Sub
End If
n = 0
Do Until RS.EOF
If RS.Fields(sField).Value > 0 Then '***********错误记录检查
TempData(0, n) = RS.Fields(sField).Value
RS.MoveNext
n = n + 1
Else
MsgBox RS.Name & "表中第" & RS.AbsolutePosition + 1 & "条记录有误！" & Chr(10) & Chr(13) & "记录值为： " & RS.Fields(sField).Value & ",处理过程中将被忽略！", , "表记录错误信息提示"
RS.MoveNext
End If
Loop
'**************数据插入内存************
'************数据统计*******************
dbname = Text1.Text '取库名给数据类型
For i = 5 To Len(dbname)
str = Right$(dbname, i)
str = Left$(str, 1)
If str = "\" Then GoTo qqq
Next i
qqq:
j = Len(dbname) - i + 2
dbname = Mid$(dbname, j, i - 5) '取库名给数据类型
FV(0) = Text2.Text
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -