Question

我有一个程序可以在逗号上拆分Lines Of Business字段，然后在名为lob的列中获取这些拆分值并将它们分配到原始行的重复行上。主键是自动生成的ID。

以下是所需行为的简明示例（为了清晰起见，省略了许多字段）：

在运行模块之前：

 +--------------------------------------------+
 |  ID   | App Code  |   Lines Of Business    |
 +-------+-----------+------------------------+
 |   1   |    AB23   | Value1, Value 2,Value3 |
 +------ +-----------+------------------------+
 |   2   |    XY45   |         Value 2        |
 +--------------------------------------------+

运行模块后：

 +-------------------------------------------------------+
 |  ID   | App Code  |   Lines Of Business    |   lob    |
 +-------+-----------+------------------------+----------+
 |   1   |    AB23   | Value1, Value 2,Value3 |  Value1  |
 +-------+-----------+------------------------+----------+
 |   2   |    XY45   |         Value 2        |  Value 2 |
 +-------+-----------+------------------------+----------+ 
 |   3   |    AB23   | Value1, Value 2,Value3 |  Value 2 |
 +-------+-----------+------------------------+----------+
 |   4   |    AB23   | Value1, Value 2,Value3 |  Value3  |
 +-------------------------------------------------------+

您将在下面的代码中看到几个类似的陈述，包括：

strSOC1 = ![SOC 1] & ""
strL3 = ![L3] & ""
strAppCode = ![App Code] & ""

和

![Current Lifecycle Phase] = strCurrentLifecyclePhase
![SOC 1] = strSOC1
![L3] = strL3

我想要做的是简化这一过程，以便不是为每个需要复制到新重复行的字段创建变量（即上表中的App Code字段），而是为所有字段（通过逗号分割生成的lob除外）会立即复制。

我有许多其他需要复制的字段，因此使用我当前的方法完成此操作将导致我创建一长串变量（或字典），并且代码将无法移植到其他表。

那么，我怎么能做到这一点？

这是我的代码，由于我对VBA很陌生，因此得到了其他SO用户的大量帮助。

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 strLinesOfBusiness       As String
    Dim strSOC1                  As String
    Dim strCurrentLifecyclePhase As String
    Dim strL3                    As String
    Dim strL4                    As String
    Dim strlob                   As String
    Dim strAppCode               As String
    Dim varData                  As Variant
    Dim i                        As Integer

    Set db = CurrentDb

    ' Add a field into the existing IIPM table called lob.
    ' Values created during the Line Of Business split will be stored here.
    Dim strDdl As String
    strDdl = "ALTER TABLE IIPM ADD COLUMN lob TEXT(255);"
    CurrentProject.Connection.Execute strDdl

    ' Select all fields that have a Line of Business and are unprocessed (lob is Null)
    strSQL = "SELECT *, lob FROM IIPM WHERE ([Lines Of Business] Is Not Null) AND ([lob] Is Null)"

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

    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)

    With rs
        While Not .EOF
            strLinesOfBusiness = ![Lines Of Business] & "" ' Append empty string to mitigate error when cell in field is null
            strCurrentLifecyclePhase = ![Current Lifecycle Phase] & ""
            strSOC1 = ![SOC 1] & ""
            strL3 = ![L3] & ""
            strAppCode = ![App Code] & ""
            varData = Split(strLinesOfBusiness, ",") ' Get all comma delimited fields

            ' Update First Record
            .Edit
            !lob = Trim(varData(0)) ' remove spaces before writing new fields
            ![App Code] = strAppCode
            .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
                    ![Lines Of Business] = strLinesOfBusiness
                    ![Current Lifecycle Phase] = strCurrentLifecyclePhase
                    ![SOC 1] = strSOC1
                    ![L3] = strL3
                    ![L4] = strL4
                    !lob = Trim(varData(i)) ' remove spaces before writing new fields
                    ![App Code] = strAppCode
                    .Update
                End With
            Next
            .MoveNext
        Wend

        .Close
        rsADD.Close

    End With

    Set rsADD = Nothing
    Set rs = Nothing

    ' Remove empty rows which only contain an ID.
    CurrentProject.Connection.Execute "DELETE FROM IIPM WHERE lob IS NULL AND [App Code] IS NULL AND [Lines Of Business] IS NULL;"

    db.Close
    Set db = Nothing

End Sub

Answer 1

首先，我找到所有这些

strL3 = ![L3] & ""

和

![L3] = strL3

有问题 - 您正在将NULL值转换为空字符串，没有理由这样做。

其次，要对所有字段执行此操作，您可以循环Recordset.Fields集合。

删除所有str<Fieldname>个变量，并执行以下操作：

Dim fld As DAO.Field

' ...

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

Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)

With rs
    While Not .EOF
        varData = Split(rs![Lines Of Business], ",") ' Get all comma delimited fields

        ' Update First Record
        .Edit
        !lob = Trim(varData(0)) ' remove spaces before writing new fields
        ' ![App Code] = strAppCode  ' unnecessary
        .Update

        ' Add records with same first field
        ' and new fields for remaining data at end of string

        For i = 1 To UBound(varData)
            rsADD.AddNew
            For Each fld In rsADD.Fields
                If fld.Name <> "lob" And fld.Name <> "ID" Then
                    ' Copy all fields except "lob" and "ID"
                    rsADD(fld.Name) = rs(fld.Name)
                End If
            Next fld
            ' lob is set separately, ID is set automatically
            rsADD!lob = Trim(varData(i))   ' remove spaces before writing new fields
            rsADD.Update
        Next i

        .MoveNext
    Wend

    .Close
    rsADD.Close

End With

Set rsADD = Nothing
Set rs = Nothing

注意：嵌套的With块有问题，所以我一直使用记录集名称。

如何将几乎所有字段值复制到Access VBA中的重复行？

1 个答案: