在Access DB中将字段拆分为多个记录

这是在Table1中使用Field1，Field2的示例代码片段

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 i           As Integer

    Set db = CurrentDb

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

    Set rsADD = db.OpenRecordset("Table1", dbOpenDynaset, dbAppendOnly)

    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
    With rs
        While Not .EOF
            strField1 = !Field1
            varData = Split(strField1, ",") ' Get all comma delimited fields

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

            ' Add records with same first field 
            ' and new fields for remaining data at end of string
            For i = 1 To UBound(varData)
                With rsADD
                    .AddNew
                    !Field1 = strField1
                    !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

编辑

更新示例以生成新的主键

如果必须基于先前的Appcode生成新的AppCode（并且将AppCode假定为文本字段），则可以使用此示例根据最后的Appcode生成唯一的主键。

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