我有一个MS Access数据库,它有一个名为Field1的字段,其中包含由逗号分隔的多个值.即,

Value1,Value 2,Value3,Value 4,Value5

我试图将值拆分为不是单独的字段,而是通过复制记录并将每个值存储在另一个字段中.这将使包含具有三个值的单元格的记录将被复制三次,每个记录在新字段中包含的值中变化.例如,

在查询/运行模块之前：

 ———– ————————
 |应用代码| Field1 |
  ———– ————————
 | AB23 | Value1,Value 2,Value3 |
  ————————————

查询/运行模块后：

 ———————————————–
 |应用代码| Field1 | Field2 |
  ———– ———————— ———-
 | AB23 | Value1,Value 2,Value3 | Value1 |
  ———– ———————— | ———-
 | AB23 | Value1,Value 2,Value3 |价值2 |
  ———– ———————— ———-
 | AB23 | Value1,Value 2,Value3 | Value3 |
  ———– ———————— ———-

到目前为止,我已经找到了几个关于拆分字段into two甚至several不同字段的问题,但我没有找到任何解决方案来垂直拆分记录.在这些解决方案中,有些使用查询而其他人使用模块,但我也不确定哪个是最有效的,所以我决定使用VBA模块.

所以,到目前为止,我发现VBA模块是最有用的：

Function CountCSWords (ByVal S) As Integer
      ' Counts the words in a string that are separated by commas.

      Dim WC As Integer, Pos As Integer
         If VarType(S) <> 8 Or Len(S) = 0 Then
           CountCSWords = 0
           Exit Function
         End If
         WC = 1
         Pos = InStr(S, ",")
         Do While Pos > 0
           WC = WC + 1
           Pos = InStr(Pos + 1, S, ",")
         Loop
         CountCSWords = WC
      End Function

      Function GetCSWord (ByVal S, Indx As Integer)
      ' Returns the nth word in a specific field.

      Dim WC As Integer, Count As Integer, SPos As Integer, EPos As Integer
         WC = CountCSWords(S)
         If Indx < 1 Or Indx > WC Then
           GetCSWord = Null
           Exit Function
         End If
         Count = 1
         SPos = 1
         For Count = 2 To Indx
           SPos = InStr(SPos, S, ",") + 1
         Next Count
         EPos = InStr(SPos, S, ",") - 1
         If EPos <= 0 Then EPos = Len(S)
         GetCSWord = Trim(Mid(S, SPos, EPos - SPos + 1))
      End Function

然而,我如何在Access Query中使用它来实现上述期望的结果？否则,有没有更好的方法来获得除Query之外的相同结论(即仅使用VBA模块)？

编辑

Note that the primary key in the Table is Application Code and not autonumber. This primary key is textual and distinct. In order for a record to be split, this will require the primary key to be duplicated, which is fine.

最佳答案 这是使用Field1中的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

编辑

Updated example to generate a new primary key

如果必须基于先前的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