MS Access 2010 vba查詢

Question

OVERVIEW

我在嘗試分解或分解程序集列表。我們從一個由設計程序生成的輸入表開始。格式是固定的。

我正試圖將每個程序集的註釋列中的結構編號與所述程序集關聯到一個新表中。

我打算創建一個查詢，選擇所有50列作爲新表的輸入，但是我在'net上發現了一些基於列名動態創建查詢的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 

Answer 1

這是一個稍微不同的方法，它會產生你想要的結果。注意，輸入值「1-TM-N * BURY 12.5 FT」可能需要一些清理，如果你不想要的「* 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 

末次

Answer 2

嘗試是這樣的，有附近沒有訪問我的手這樣的句法問題ms可以被滿足，並且使用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