Разделить поле на несколько записей в базе данных Access

sql ms-access access-vba ms-access-2010

5192 просмотра

1 ответ

2707 Репутация автора

У меня есть база данных MS Access, в которой есть поле с именем Field1, содержащее несколько значений, разделенных запятыми. т.е.

Value1,Value 2, Value3, Value 4,Value5

Я пытаюсь разделить значения не на отдельные поля, а путем дублирования записи и сохранения каждого значения в другом поле. Это будет так, что запись, содержащая ячейку с тремя значениями, будет продублирована три раза, причем каждая запись будет отличаться по значению, содержащемуся в новом поле. Например,

Перед запросом / запуском модуля:

+-----------+------------------------+ | App Code | Field1 | +-----------+------------------------+ | AB23 | Value1, Value 2,Value3 | +------------------------------------+

После запроса / запуска модуля:

+-----------------------------------------------+ | App Code | Field1 | Field2 | +-----------+------------------------+----------+ | AB23 | Value1, Value 2,Value3 | Value1 | +-----------+------------------------|----------+ | AB23 | Value1, Value 2,Value3 | Value 2 | +-----------+------------------------+----------+ | AB23 | Value1, Value 2,Value3 | Value3 | +-----------+------------------------+----------+

До сих пор я нашел несколько вопросов о разделении поля на два или даже несколько различных полей, но я не нашел никакого решения для разделения записи по вертикали. Из этих решений некоторые используют запросы, а другие используют модули, но я также не уверен, какой из них наиболее эффективен, поэтому я решил использовать модуль 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 для достижения вышеупомянутых желаемых результатов? Иначе, есть ли лучший способ прийти к такому же выводу, кроме запроса (то есть исключительно с модулем VBA)?

РЕДАКТИРОВАТЬ

Обратите внимание, что первичным ключом в таблице является, Application Codeа не автоматический номер. Этот первичный ключ является текстовым и отчетливым. Чтобы разделить запись, потребуется дублировать первичный ключ, что вполне нормально.

Автор: Paradox Источник Размещён: 18.07.2016 02:19

Ответы (1)


1 плюс

4205 Репутация автора

Решение

Вот пример кода с использованием Field1, Field2 в вашей таблице 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

Пример до

После запуска Программы

РЕДАКТИРОВАТЬ

Обновленный пример для генерации нового первичного ключа

Если вам нужно сгенерировать новый код 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

Пример нового ключа AppCode после запуска кода

Автор: dbmitch Размещён: 18.07.2016 04:07
Вопросы из категории :
32x32