MS Access 2010 vba 查询

Posted 2023-04-19

【中文标题】MS Access 2010 vba 查询

【英文标题】：MS Access 2010 vba query

【发布时间】：2013-04-10 22:28:00

【问题描述】：

概览

我正在尝试分解或分解装配列表。我们从设计程序生成的输入表开始。格式是固定的。

我正在尝试将注释列中的每个程序集分解为一个新表，其中包含与该程序集关联的结构编号。

我打算创建一个查询，选择所有 50 列作为新表的输入，但我在网上找到了一些 VBA 代码，它可以根据列名动态创建查询。

代码似乎可以工作，但它最终所做的只是从第一个结构编号中取出组装项，然后在其余结构编号上重复它们。

我很接近...但距离解决方案还很远 - 所以如果有人对如何更正我的查询有任何想法，我会全力以赴。

提前致谢。

M.

输入表样本数据

    StructureNumber Structure  Comment  2   Structure  Comment  3   Structure  Comment  4   Structure  Comment  5   Structure  Comment  6   Structure  Comment  7   Structure  Comment  8   Structure  Comment  9   Structure  Comment  10
26  1-S80-H2    1-TS-15PG   1-TMF-CB    1-TM-124TDS 1-TM-9D(22) 1-TM-103    22-TG-1G    11-TG-21C   11-TA-5L
27  1-S90-H4*   1-TBP-161A  1-C9-3A(12) 1-TMF-4B    1-TM-9D(2)  1-TM-101    2-TG-1G 1-TG-21C    1-TA-5L
28  1-S90-H5*   1-TBP-161A  1-C9-3A(12) 1-TMF-4B    1-TM-9D 1-TM-101    2-OPT-D 1-TM-N  * BURY 12.5 FT
29  2-S105-H1*  1-TH-10PV4XX-SP 1-C9-3A(12)D    1-TMF-4B    1-TM-9F 2-TM-101    1-OPT-D 1-OPT-2D    1-TM-N
30  3-S90-H2    1-TH-15PDX  1-TMF-112T  1-TM-9L 3-TM-101    1-OPT-D 1-OPT-2D    1-TM-N  

输出表样本

ID  StrNum  Assembly    Qty
22033   26  S80-H2  1.00
22067   26  TS-15PG 1.00
22101   26  TMF-CB  1.00
22135   26  TM-124TDS   1.00
22169   26  TM-9D(22)   1.00
22203   26  TM-103  1.00
22237   26  TG-1G   22.00
22271   26  TG-21C  11.00
22305   26  TA-5L   11.00
22339   26  OPT-D   1.00
22373   26  TM-N    1.00
22034   27  S80-H2  1.00
22068   27  TS-15PG 1.00
22102   27  TMF-CB  1.00
22136   27  TM-124TDS   1.00
22170   27  TM-9D(22)   1.00
22204   27  TM-103  1.00
22238   27  TG-1G   22.00
22272   27  TG-21C  11.00
22306   27  TA-5L   11.00
22340   27  OPT-D   1.00
22374   27  TM-N    1.00
22035   28  S80-H2  1.00
22069   28  TS-15PG 1.00
22103   28  TMF-CB  1.00
22137   28  TM-124TDS   1.00
22171   28  TM-9D(22)   1.00
22205   28  TM-103  1.00
22239   28  TG-1G   22.00
22273   28  TG-21C  11.00
22307   28  TA-5L   11.00
22341   28  OPT-D   1.00
22375   28  TM-N    1.00

VBA 代码

Option Compare Database

Function TransposeTable()
Dim rsMySet As DAO.Recordset
Dim strSQL As String
Dim OutputTable As String
Dim InputTable As String

Dim i As Integer

InputTable = "MatrixDataset"
OutputTable = "TabularDataset"

'Open the original matrix-style dataset
Set rsMySet = CurrentDb.OpenRecordset(InputTable)

'Start the count at the position number of the first column-oriented field
'Remember that Recordsets start at 0
'For j = 1 To rsMySet.RecordCount - 1
For i = 1 To rsMySet.Fields.Count - 1

'Use the recordset field.name property to build out the SQL string for the current field

strSQL = "INSERT INTO TabularDataset ([StrNum],[Assembly]) " & _
"SELECT [MatrixDataset].[StructureNumber] as StrNum," & _
"'" & rsMySet.Fields(i).Value & "'" & " AS Assembly " & "FROM MatrixDataset WHERE " & _
"'" & rsMySet.Fields(i).Value & "'" & " <> '';"

'Execute the SQL string

CurrentDb.Execute strSQL

'Move to the next column-oriented field

Next i


' Now we need to update the assembly to pull the quantity from
' the front of the field and place it in the Qty field

' UPDATE OutputTable SET Qty = left(Assy,instr(Assy,"-"-1))
strSQL = "UPDATE " & "`" & OutputTable & "` as ot" & " SET ot.Qty = left(ot.Assembly,instr(ot.Assembly,'-')-1);"
CurrentDb.Execute strSQL

strSQL = "UPDATE " & "`" & OutputTable & "` as ot" & " SET ot.Assembly = right(ot.Assembly,len(ot.Assembly)-instr(ot.Assembly,'-'));"
CurrentDb.Execute strSQL

'strSQL = "SELECT Assembly, Qty FROM `" & OutputTable & "` GROUP BY Assembly ORDER BY Assembly;"
'CurrentDb.Execute strSQL

End Function

【参考方案1】：

这是一种略有不同的方法，可以产生您想要的结果。请注意，如果您不希望结果中出现“* BURY 12.5 FT”，则输入值“1-TM-N * BURY 12.5 FT”可能需要进行一些清理

Sub BuildOutputTable()
Dim db As DAO.Database
Set db = CurrentDb
Dim rsInp As DAO.Recordset
Set rsInp = db.OpenRecordset("SELECT * FROM inpdata")
Dim rsOut As DAO.Recordset
Set rsOut = db.OpenRecordset("SELECT * FROM outdata")

Do Until rsInp.EOF
  rsOut.AddNew
  For i = 1 To rsInp.Fields.Count - 1
    rsOut.AddNew
    rsOut!StrNum = rsInp.Fields(0).Value
    If Not IsNull(rsInp.Fields(i)) Then
        Dim FirstDashPos As Integer
        FirstDashPos = InStr(rsInp.Fields(i), "-")
        rsOut!Qty = Val(Left(rsInp.Fields(i), FirstDashPos))
        rsOut!Assembly = Right(rsInp.Fields(i), Len(rsInp.Fields(i)) - FirstDashPos)
    End If
    rsOut.Update
  Next
  rsInp.MoveNext
Loop

结束子

【讨论】：

我微薄的 ACCESS VBA 技能无法解决问题，但我总是乐于学习。非常好。谢谢！

【参考方案2】：

尝试这样的事情，我的手附近没有 Access，因此可以解决语法问题，并使用 ADO 而不是 DAO

Option Compare Database

Sub TransposeTable()
Dim Conn as ADODB.Connection
Dim tblInput As ADODB.Recordset
Dim OutputTable As String
Dim InputTable As String

Dim i As Integer
Dim StrNum As String
Dim Assembly As String
Dim Qty as Integer

InputTable = "MatrixDataset"
OutputTable = "TabularDataset"

set Conn = CurrentProject.Connection
Conn.Execute "create table " &    OutputTable & _
             " ( StrNum Text(20), Assembly Text(100), Qty Long) "

set tblInput = new ADODB.Recordset
tblInput.Open InputTable

do while not tblInput.EOF
    StrNum = tblInput(0)
    For i = 1 To tblInput.Fields.Count - 1
        Assembly = Right( tblInput(i), Len(tblInput(i)) - instr(tblInput(i), "-"))
        Qty = CInt(Left( tblInput(i), instr(tblInput(i), "-") - 1))
        Conn.Execute "insert " & OutputTable & "(StrNum, Assembly, Qty)" & _
         " values ('" & StrNum &"', '" & Assemby & "', " & CStr(Qty) & ")"
    Next i
    tblInput.MoveNext
loop 


tblInput.Close
set tblInput = Nothing

End Sub

【讨论】：

另一个非常有帮助的答案。我现在正在尝试。