Разделение данных и очистка таблицы доступа

Question

У меня есть таблица со столбцами ниже. Я пытаюсь разделить Дополнительный рис и Дополнительный элемент в новых записях, но с ними все еще связан старый идентификатор.

Так что я в конечном итоге с таблицей, как показано ниже. Для идентификатора 89 есть два дополнительных рис, но только один дополнительный элемент, в таких записях пропущенный дополнительный элемент будет оставлен пустым, или 9999 нужно будет внести в запись.

Код ниже взят из Разделить поле на несколько записей в базе данных Access . это приближает меня к тому, что я хочу сделать. Код разбивает один столбец на несколько, но мне нужно сделать два столбца на множество и найти способ справиться с записью, где есть дополнительный рис, но нет дополнительного элемента или наоборот.

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

Создайте вторую таблицу с полями:
Идентификатор (автономный номер)
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