在 Access DB 中将字段拆分为多条记录
Split Field Into Multiple Records in Access DB
我有一个 MS Access 数据库，它有一个名为 Field1 的字段，其中包含多个以逗号分隔的值。即，
Value1,Value 2, Value3, Value 4,Value5
我试图不将值拆分为单独的字段，而是通过复制记录并将每个值存储在另一个字段中。这将使得包含具有三个值的单元格的记录将被复制三次，每个记录的新字段中包含的值都不同。例如，
在 query/running 模块之前：
+-----------+------------------------+
| App Code | Field1 |
+-----------+------------------------+
| AB23 | Value1, Value 2,Value3 |
+------------------------------------+
在 query/running 模块之后：
+-----------------------------------------------+
| App Code | Field1 | Field2 |
+-----------+------------------------+----------+
| AB23 | Value1, Value 2,Value3 | Value1 |
+-----------+------------------------|----------+
| AB23 | Value1, Value 2,Value3 | Value 2 |
+-----------+------------------------+----------+
| AB23 | Value1, Value 2,Value3 | Value3 |
+-----------+------------------------+----------+
到目前为止，我发现了几个关于拆分一个字段into two or even 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 查询中使用它来实现上述预期结果？否则，除了查询（即仅使用 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.
这是一段使用 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
编辑
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
我有一个 MS Access 数据库，它有一个名为 Field1 的字段，其中包含多个以逗号分隔的值。即，
Value1,Value 2, Value3, Value 4,Value5
我试图不将值拆分为单独的字段，而是通过复制记录并将每个值存储在另一个字段中。这将使得包含具有三个值的单元格的记录将被复制三次，每个记录的新字段中包含的值都不同。例如，
在 query/running 模块之前：
+-----------+------------------------+
| App Code | Field1 |
+-----------+------------------------+
| AB23 | Value1, Value 2,Value3 |
+------------------------------------+
在 query/running 模块之后：
+-----------------------------------------------+
| App Code | Field1 | Field2 |
+-----------+------------------------+----------+
| AB23 | Value1, Value 2,Value3 | Value1 |
+-----------+------------------------|----------+
| AB23 | Value1, Value 2,Value3 | Value 2 |
+-----------+------------------------+----------+
| AB23 | Value1, Value 2,Value3 | Value3 |
+-----------+------------------------+----------+
到目前为止，我发现了几个关于拆分一个字段into two or even 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 查询中使用它来实现上述预期结果？否则，除了查询（即仅使用 VBA 模块）之外，是否有更好的方法得出相同的结论？
编辑
Note that the primary key in the Table is
Application Codeand 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.
这是一段使用 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
编辑
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