分离数据和清理Access Table

Question

我有一个包含以下列的表格。我正在尝试将 Additional Fig 和 Additional Item 分开在新记录中，但旧 ID 仍与它们相关联。

所以我最终得到了一张如下表所示的表格。在 ID 89 上有两个额外的无花果，但只有一个额外的项目，在这样的记录中，缺少的附加项目将留空或 9999 需要放入记录中。

下面的代码来自Split Field Into Multiple Records in Access DB。它让我接近我想做的事情。代码将一列拆分为多列，但我需要将两列拆分为多列，并找到一种方法来处理有额外无花果但没有额外项目的记录，反之亦然。

Option Explicit

    Public Sub ReformatTable()

        Dim db          As DAO.Database
        Dim rs          As DAO.Recordset
        Dim rsADD       As DAO.Recordset

        Dim strSQL      As String
        Dim strField1   As String
        Dim strField2   As String
        Dim varData     As Variant
        Dim strAppCode  As String
        Dim i           As Integer

        Set db = CurrentDb

        ' Select all eligible fields (have a comma) and unprocessed (Field2 is Null)
        strSQL = "SELECT AppCode, Field1, Field2 FROM Table1 WHERE ([Field1] Like ""*,*"") AND ([Field2] Is Null)"

        ' This recordset is only used to Append New Records
        Set rsADD = db.OpenRecordset("Table1", dbOpenDynaset, dbAppendOnly)

        Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
        With rs
            While Not .EOF

                ' Do we need this for newly appended records?
                strAppCode = !AppCode

                strField1 = !Field1
                varData = Split(strField1, ",") ' Get all comma delimited fields

                ' Update First Field
                .Edit
                !Field2 = Trim(varData(0)) ' remove spaces before writing new fields
                .Update

                ' Add new fields for remaining data at end of string
                For i = 1 To UBound(varData)
                    With rsADD

                        .AddNew

                        ' ***If you need a NEW Primary Key based on current AppCode
                        !AppCode = strAppCode & "-" & i

                        ' ***If you remove the Unique/PrimaryKey and just want the same code copied
                        !AppCode = strAppCode

                        ' Copy previous Field 1
                        !Field1 = strField1

                        ' Insert Field 2 based on extracted data from Field 1
                        !Field2 = Trim(varData(i)) ' remove spaces before writing new fields
                        .Update
                    End With
                Next
                .MoveNext
            Wend

            .Close
            rsADD.Close

        End With

        Set rsADD = Nothing
        Set rs = Nothing
        db.Close
        Set db = Nothing

    End Sub

Answer 1

用字段构建第二个表：
ID（自动编号）
FID（长整数）
图（文）
项目（文字）

考虑：

Dim db          As DAO.Database
Dim rsOld       As DAO.Recordset
Dim rsNew       As DAO.Recordset
Dim strF1       As String
Dim strF2       As String
Dim varF        As Variant
Dim varI        As Variant
Dim strID       As String
Dim x           As Integer
Dim intLoop     As Integer
Set db = CurrentDb
Set rsOld = db.OpenRecordset("Table1")
db.Execute "DELETE FROM Table2"
Set rsNew = db.OpenRecordset("Table2")
With rsOld
    Do While Not .EOF
        strID = !ID
        strF1 = Replace(Nz(!AdditionalFig, ""), ", ", ",")
        If Right(strF1, 1) = "," Then strF1 = Left(strF1, Len(strF1) - 1)
        varF = Split(strF1, ",")
        strF2 = Replace(Nz(!AdditionalItem, ""), ", ", ",")
        If Right(strF2, 1) = "," Then strF2 = Left(strF2, Len(strF2) - 1)
        varI = Split(strF2, ",")
        intLoop = IIf(UBound(varF) > UBound(varI), UBound(varF), UBound(varI)) + 1
        For x = 1 To intLoop
            With rsNew
                .AddNew
                !FID = strID
                If UBound(varF) >= x - 1 Then !Fig = varF(x - 1)
                If UBound(varI) >= x - 1 Then !Item = varI(x - 1)
                .Update
            End With
        Next
        .MoveNext
    Loop
End With