使用 VBA 循环查询并输出结果
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16925075/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Using VBA to loop through a query and outputting results
提问by Chris Jones
So what I have here is a query that displays a Baseball players Name, Salary, and then shows normal baseball stats such as Hits, RBIs, etc. What I want to is have the code create a query at the end that will contain the player's name and and the result of an expression that looks like
所以我这里有一个查询，它显示棒球运动员的姓名、薪水，然后显示正常的棒球统计数据，如命中、打点等。我想要的是让代码在最后创建一个查询，其中将包含球员的名称和表达式的结果看起来像
IIf([H]<>0,Format(([Salary]/[H]),'$#,###.##'),0) AS Per_H
I basically want to be able to make it apply that formula to every column after their name and salary.
我基本上希望能够将这个公式应用到他们姓名和薪水之后的每一列。
Right now I have
现在我有
Table PlayerSal
NAME SALARY H R HR
With H being Hits, R being Runs, and HR being Homeruns. My resulting query that I want should look like this.
H 是 Hits，R 是 Runs，HR 是 Homeruns。我想要的结果查询应该是这样的。
Player_Per
NAME Per_H, Per_R, Per_HR.
What exactly do I need to do?
我到底需要做什么？
Edit
编辑
I should add, yes, I know I can just input that very same function for each stat that I want to calculate it for, that isn't the point. I am trying to expand my knowledge while applying it to something that I find interesting. However, I know that this could probably be expanded to other things down the road.
我应该补充一点，是的，我知道我可以为我想要计算的每个统计数据输入完全相同的函数，这不是重点。我试图扩展我的知识，同时将其应用于我觉得有趣的事情。但是，我知道这可能会扩展到未来的其他事情。
采纳答案by Johnny Bones
Sorry, brother. Last shot. This code works. However, it needs a small tweak because it doesn't loop through all the records.
对不起，兄弟。最后一枪。此代码有效。但是，它需要一个小的调整，因为它不会遍历所有记录。
Public Function HitTest()
Dim db As Database
Dim rec As DAO.Recordset
Dim fld As DAO.Field
Set db = CurrentDb
Set rec = db.OpenRecordset("tblPlayers")
EditTable = "tblPlayers"
For Each fld In rec.Fields
If fld.Name <> "PName" And fld.Name <> "Salary" And Left(fld.Name, 4) <> "Per_" Then
strFieldName = "Per_" & fld.Name & ""
'rs.Fields (strFieldName)
'X = "IIf(rec([" & fld.Name & "]) <> 0, Format((rec([Salary]) / rec([" & fld.Name & "])), '$#,###.##'), 0)"
If FieldExists(EditTable, strFieldName) Then
Else
'AltTable = "ALTER TABLE " & EditTable & " ADD COLUMN " & strFieldName & " Double;"
'CurrentDb.Execute (AltTable)
End If
rec.Edit
X = IIf(rec((fld.Name)) <> 0, Format((rec("Salary") / rec((fld.Name))), "$#,###.##"), 0)
rec.Fields(strFieldName).Value = X
rec.Update
End If
Next fld
End Function
回答by Johnny Bones
I'm sure I'm not understanding the question, but you could do something like this:
我确定我不理解这个问题，但你可以这样做：
Dim db as database
dim rec as recordset
Dim fld as Field
Set db = CurrentDB
Set rec = db.OpenRecordset("PlayerSal")
For each Fld.name in rec
If Fld.Name <> "Name" and Fld.Name <> "Salary" then
Per_" & Fld.Name & " = IIf([" & Fld.Name & "]<>0,Format(([Salary]/[" & Fld.Name & "]),'$#,###.##'),0)
End If
Next Fld.Name
The above is ENTIRELY "aircode" and more than likely won't work out of the box, but hopefully it gives you an idea.
以上完全是“aircode”，很可能无法立即使用，但希望它能给你一个想法。
回答by Johnny Bones
I did a little more research on this. Looks like you'll need to open a recordset to make sure all your "Per_" fields exist and determine any new fields you need to add. Then you need to close the recordset and run ALTER TABLE statements to create any new fields you need. Then you need to re-open the recordset and update your fields with the value of your formula.
我对此进行了更多研究。看起来您需要打开一个记录集以确保所有“Per_”字段都存在并确定您需要添加的任何新字段。然后您需要关闭记录集并运行 ALTER TABLE 语句来创建您需要的任何新字段。然后您需要重新打开记录集并使用公式的值更新您的字段。
You can probably eliminate the first 2 steps if you just add the new fields manually, but that's how you would have to do it. If you wanted to eliminate those first 2 steps, you'd end up with something like this:
如果您只是手动添加新字段，您可能可以取消前两个步骤，但这就是您必须这样做的方式。如果你想消除前两个步骤，你最终会得到这样的结果：
Dim db As Database
Dim rec As DAO.Recordset
Dim fld As DAO.Field
Set db = CurrentDb
Set rec = db.OpenRecordset("tblPlayers")
EditTable = "tblPlayers"
For Each fld In rec.Fields
If fld.Name <> "PName" And fld.Name <> "Salary" Then
strFieldName = "Per_" & fld.Name & ""
X = "IIf([" & fld.Name & "] <> 0, Format(([Salary] / [" & fld.Name & "]), '$#,###.##'), 0)"
If FieldExists(EditTable, strFieldName) Then
rec.Edit
rec.Fields(strFieldName).Value = X
rec.Update
Else
End If
End If
Next fld
Then you need this function to check if the field exists:
然后你需要这个函数来检查字段是否存在：
Public Function FieldExists(ByVal tableName As String, ByVal fieldName As String) As Boolean
Dim nLen As Long
On Error GoTo Failed
With DBEngine(0)(0).TableDefs(tableName)
.Fields.Refresh
nLen = Len(.Fields(fieldName).Name)
If nFldLen > 0 Then FieldExists = True
End With
Exit Function
Failed:
If Err.Number = 3265 Then Err.Clear ' Error 3265 : Item not found in this collection.
FieldExists = False
End Function
