访问 VBA - 两个前最大/最小字段循环的绝对最大值

Question

我不断收到来自我的 Access VBA 代码的错误“无效使用 Null”。此 VBA 代码的目标是遍历一系列包含重复的最大值、最小值、平均值的表，并将平均值字段替换为之前的最大值和最小值字段的绝对最大值。

Left Mx max   Left Mx min   Left Mx mean    Right Mx max    Right Mx min    Right Mx mean
50.754       -33.002        50.75           50.642          -33.0           50.642
-95.355      -167.889       167.88          -95.822         -168.373        168.373
63.636       -45.956        63.636          63.473          -45.984         63.473
-97.065      -165.954       165.954         -97.442         -166.365        166.365

我拥有的当前代码能够通过单个表，但是一旦到达末尾，我就会收到错误。

当前代码

Sub absolute()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim fld As DAO.Field
Dim tdf As DAO.TableDef

Dim maximum As Double
Dim minimum As Double
Dim newvalue As Double
Dim newfield As String
Dim newcase As String
Dim sqlStatement As String

Set db = CurrentDb


For Each tdf In db.TableDefs
If Not (tdf.Name Like "MSys*" Or tdf.Name Like "Case" Or tdf.Name Summmary" 
Or tdf.Name Like "~*") Then

Set rs1 = tdf.OpenRecordset()

    rs1.MoveFirst
    While Not rs1.EOF Or Not Null
        For Each fld In rs1.Fields
        newfield = fld.Name
            If newfield <> "case" Then
                If Right(newfield, 3) = "max" Then
                        maximum = rs1(newfield).Value
                ElseIf Right(newfield, 3) = "min" Then
                    minimum = rs1(newfield).Value
                ElseIf Right(newfield, 4) = "mean" Then
                rs1.Edit
                rs1(newfield).Value = iMax(maximum, minimum)
                rs1.Update
                End If
            End If
        Next fld
    rs1.MoveNext
    Wend
End If
Next tdf


Set fld = Nothing
Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
Set tdf = Nothing

End Sub

imax 在哪里：

Public Function iMax(ParamArray p()) As Variant
Dim i As Long
Dim v As Variant

v = p(LBound(p))
For i = LBound(p) + 1 To UBound(p)
  If Abs(v) < Abs(p(i)) Then
     v = p(i)
  End If
Next
iMax = Abs(v)
End Function

此外，如何在当前代码中将字段名称从“mean”更改为“abs”？

编辑

代码停止于：

maximum = rs1(newfield).Value
'where rs1(newfield which is storing left mx max) = null 

Answer 1

更改以下部分，这应该可以消除您的 Null 错误。

Set rs1 = tdf.OpenRecordset()
rs1.MoveFirst
While Not rs1.EOF Or Not Null
    'For Each fld In rs1.Fields    -- old
     For Each fld In tdf.Fields   '-- new 
    newfield = fld.Name
        If newfield <> "case" Then
            If Right(newfield, 3) = "max" Then
                    maximum = rs1(newfield).Value
            ElseIf Right(newfield, 3) = "min" Then
                minimum = rs1(newfield).Value
            ElseIf Right(newfield, 4) = "mean" Then
            rs1.Edit
            rs1(newfield).Value = iMax(maximum, minimum)
            rs1.Update
            End If
        End If
    Next fld
    rs1.MoveNext
Wend
End If
Next tdf

但我建议将程序分开（单一责任）。例如用于评估字段名的单独函数。

我不知道您更改字段名称的确切含义。是否要通过代码更改表格的字段名？

为了更改字段名，我只是编写了客户端的必要部分来演示子的调用

Public Sub ClientCall()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim searchName As String

Set db = CurrentDb
Set tdf = db.TableDefs("Tabelle1")
searchName = "Max"
ChangeFieldName tdf, searchName, Len(searchName), "Abs"

结束子

Sub ChangeFieldname 没有任何错误处理，例如表是只读的，类似的东西

Public Sub ChangeFieldName(ByRef Table As DAO.TableDef, ByVal ExistingAbbreviation As String, ByVal CompareLastCharactersOfField As Integer, ByVal NewAbbrevation As String)
' assuming that existingAbbreviation has exactly the same number of characters as the CompareLastCharactersOfField
Dim fld As DAO.Field
Dim currentFieldName As String

For Each fld In Table.Fields
    currentFieldName = fld.Name
    FieldSuffix = Right(currentFieldName, CompareLastCharactersOfField)
    If FieldSuffix = ExistingAbbreviation Then
        'take the part of the fieldname which should stay
        fieldPrefix = Left(currentFieldName, Len(currentFieldName) - CompareLastCharactersOfField)
        newFieldName = fieldPrefix + NewAbbrevation
        fld.Name = newFieldName
    End If
Next fld
End Sub

关于记录集中的空异常，这应该会有所帮助。值 0 是一个示例。我不知道你想如何处理 Null 值，所以请以它为例。问题是双精度值不能包含空值！

If IsNull(rs1(newField).Value) Then
        maximum = 0
    Else
        maximum = rs1(newField).Value
    End If