我需要Microsoft Access中的一些VBA代码的帮助,这些代码将为下面的每个字段生成最大/最小值,并返回相应的大小写
强制表
case Flxmax Flxmin Frxmax Frxmin
hs00p16010od 582.24 666.81 796.44 -451.15
hs00p16015od 878.7 878.7 1096.3 -500.36
hs00p16020od 1071.95 1071.9 1281.2 -743.05
hs00p16025od 1186.65 1186.6 1397.8 -959.36
所需输出
Field Force Case
Flxmax 1186.65 hs00p16025od
Flxmin 666.81 hs00p16010od
Frxmax 1397.8 hs00p16025od
Frxmin -959.36 hs00p16025od
此外,如果表格中有相同的最大/最小值,我只需在结果中选择一个。
上面显示的字段有30个。我相信我必须循环遍历每个字段,直到我到达结尾并记录最大/最小行,但我不确定如何编写此代码。任何帮助都会很棒。
当前代码
Public Sub Max()
Dim sqlStatement As String
Dim rs1 As Object
Dim rs2 As Object
Dim fld As Field
Dim strName As String
Dim maximum As Long
Dim minimum As Long
sqlStatement = "SELECT * FROM Force;"
Set rs1 = CurrentDb().OpenRecordset(sqlStatement)
sqlStatement = "SELECT * FROM Results;"
Set rs2 = CurrentDb().OpenRecordset(sqlStatement)
rs2.AddNew 'Add new record to result table
'Field order to loop though: max, min, skip, max, min, skip...where skip implies a skipped field
For Each fld In rs1.Fields
With rs1
maximum = DMax(fld, Force)
'Write onto results tables
End With
Next fld
rs2.Update 'Update results table
Set rs1 = Nothing
Set rs2 = Nothing
End Sub
答案 0 :(得分:1)
你很亲密。基本上缺少的是必须将每个最小/最大字段值分别添加/更新到目标表。
修订代码
Public Sub Max()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim fld As DAO.Field
Dim newvalue As Long
Dim newfield As String
Dim newcase As String
Dim sqlStatement As String
Set db = CurrentDb
sqlStatement = "SELECT * FROM Force;"
Set rs1 = db.OpenRecordset(sqlStatement)
sqlStatement = "SELECT * FROM Results;"
Set rs2 = db.OpenRecordset(sqlStatement)
For Each fld In rs1.Fields
rs1.MoveFirst
newfield = fld.Name
If newfield <> "case" Then
newvalue = rs1(newfield).Value
While Not rs1.EOF
If Right(newfield, 3) = "min" Then
If newvalue > rs1(newfield).Value Then
newvalue = rs1(newfield).Value
newcase = rs1("Case").Value
End If
ElseIf Right(newfield, 3) = "max" Then
If newvalue < rs1(newfield).Value Then
newvalue = rs1(newfield).Value
newcase = rs1("Case").Value
End If
End If
rs1.MoveNext
Wend
rs2.AddNew
rs2!Field.Value = newfield
rs2!Force.Value = newvalue
rs2!Case.Value = newcase
rs2.Update
End If
Next fld
Set fld = Nothing
Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
End Sub
这是空气代码,我没有测试数据。您可能需要添加一些错误处理。