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

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

我不喜欢＆＃39; t确切地知道改变字段名称的含义。是否要按代码更改表的字段名？

为了更改fieldname，我只是编写了客户端的必要部分来演示调用sub

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"

End Sub

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

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

关于记录集中的null异常，这应该有帮助。值0是一个示例。我不喜欢＆＃39;知道你想如何对待Null值，所以请以它为例。问题是double值不能包含空值！

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

访问VBA - 绝对最大两个上下限最大/最小字段循环

1 个答案: