訪問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