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

Question

我不断收到来自我的访问 VBA 代码的错误 "Invalid use of Null"。这段VBA代码的objective是循环遍历一系列包含重复的max、min、mean值的table，将mean域替换为前面max的绝对最大值和最小字段。

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

我的当前代码能够通过一个 table，但是一旦它到达终点，我就会收到错误。

当前代码

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

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

我不明白您所说的更改字段名称的确切含义。您要通过代码更改 table 的字段名称吗？

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

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 没有任何错误处理，例如Table 是只读的，诸如此类

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

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

Access VBA - Absolute maximum of two pevious max/min fields loop

ms-access

vba