sql - tabla - Dividir campo en múltiples registros en Access DB
separar un registro en sql (1)
Tengo una base de datos de MS Access que tiene un campo llamado Field1 que contiene múltiples valores delimitados por comas. es decir,
Value1,Value 2, Value3, Value 4,Value5
Estoy intentando dividir los valores no en campos separados, sino duplicando el registro y almacenando cada valor en otro campo. Esto será tal que un registro que contenga una celda con tres valores se duplicará tres veces, y cada registro variará en el valor contenido en el nuevo campo. Por ejemplo,
Antes del módulo de consulta / ejecución:
+-----------+------------------------+ | App Code | Field1 | +-----------+------------------------+ | AB23 | Value1, Value 2,Value3 | +------------------------------------+
Después del módulo de consulta / ejecución:
+-----------------------------------------------+ | App Code | Field1 | Field2 | +-----------+------------------------+----------+ | AB23 | Value1, Value 2,Value3 | Value1 | +-----------+------------------------|----------+ | AB23 | Value1, Value 2,Value3 | Value 2 | +-----------+------------------------+----------+ | AB23 | Value1, Value 2,Value3 | Value3 | +-----------+------------------------+----------+
Hasta ahora, he encontrado varias preguntas sobre dividir un campo en dos o incluso varios campos diferentes, pero no he encontrado ninguna solución para dividir el registro verticalmente. De estas soluciones, algunas usan consultas y otras usan módulos pero tampoco estoy seguro de cuál es la más eficiente, así que decidí usar un módulo de VBA.
Y entonces, aquí está el módulo de VBA que he encontrado que es el más útil hasta ahora:
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
Sin embargo, ¿cómo podría usar esto en una consulta de acceso para lograr los resultados deseados antes mencionados? De lo contrario, ¿hay una mejor manera de llegar a la misma conclusión que no sea una consulta (es decir, únicamente con un módulo de VBA)?
EDITAR
Tenga en cuenta que la clave principal en la tabla es el
Application Codey no el autonumber. Esta clave primaria es textual y distinta. Para que un registro se divida, esto requerirá la duplicación de la clave principal, lo cual está bien.
Aquí hay una muestra de código usando Field1, Field2 en su a Table1
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
EDITAR
Ejemplo actualizado para generar una nueva clave principal
Si tiene que generar un nuevo Código de aplicación basado en el Código de aplicación anterior (AND suponiendo que el Código de la aplicación es un campo de texto), puede usar este ejemplo para generar una clave principal única basada en el último código de la aplicación.
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
