1

概述

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

我试图将评论列中的每个程序集分解为一个新表，其中的结构号与该程序集相关联。

我打算创建一个查询，选择所有 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
4

2 回答 2

0

尝试这样的事情，我的手附近没有访问权限，因此可以解决语法问题，并使用 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
于 2013-04-11T00:03:54.327 回答
0

这是一种稍微不同的方法，可以产生您想要的结果。请注意，如果您不希望结果中出现“* 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

结束子

于 2013-04-11T00:10:59.397 回答