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

Question

我一直收到一个错误“无效使用NULL”从我的Access VBA代码。这个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 

此外我如何可以改变从字段名 “的意思是” 当前代码内 “ABS”？

编辑

的代码在停止：

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

Answer 1

更改以下部分本应消除你空的错误。

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" 

末次

小组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是一个例子。我不知道你想如何处理空值，所以请以此为例。问题是double值不能包含空值！

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