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

我有一个程序，它在逗号上拆分

业务线

字段，然后获取这些拆分值并将它们分布在原始行的重复行上，在一个名为

lob

的列中。主键是自动生成的

ID

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

在运行模块之前：

运行模块后：

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

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

及

我想做的是简化这个过程，这样就不用为需要复制到新的重复行（即上表中的

App code

字段）的每个字段创建变量，而是立即复制所有字段（通过逗号拆分生成的

lob

）

我有几十个其他字段需要复制，所以用我当前的方法来完成这项工作会导致我创建一个长的变量列表（或字典），并且代码无法移植到其他表中

那么，我怎样才能做到这一点呢

这是我的代码，它从其他SO用户那里得到了很多帮助，因为我是VBA新手

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

---

首先，我发现所有这些

strL3 = ![L3] & ""

及

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

其次，要对所有字段执行此操作，可以循环

记录集.fields

集合

去掉所有

str

变量，然后执行以下操作：

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

Dim fld作为DAO.Field
' ...
Set rsADD=db.OpenRecordset（“IIPM”，dbOpenDynaset，dbAppendOnly）
Set rs=db.OpenRecordset（strSQL，dbOpenDynaset）
用rs
而不是
varData=Split（rs！[业务线]，“，”）获取所有逗号分隔的字段
'更新第一条记录
编辑
!lob=Trim（varData（0））'在写入新字段之前删除空格
' ![应用程序代码]=不需要代码
.更新
'添加第一个字段相同的记录
'和字符串末尾剩余数据的新字段
对于i=1到UBound（varData）
rsADD.AddNew
对于rsADD.字段中的每个fld
如果fld.Name“lob”和fld.Name“ID”，则
'复制除“lob”和“ID”之外的所有字段'
rsADD（层名称）=rs（层名称）
如果结束
下一个fld
'lob单独设置，ID自动设置
rsADD！lob=Trim（varData（i））'在写入新字段之前删除空格
rsADD.更新
接下来我
.下一步
温德
.结束
rsADD.关闭
以
设置rsADD=Nothing
设置rs=无

---

注意：嵌套

和
块是有问题的，因此我一直使用记录集名称。
我这样做的原因是，如果我没有将其转换为字符串，那么每当该字段中的单元格有空值时，我就会得到一个错误。不过，我同意你的看法，这肯定不是一个最佳解决方案。我明白了，这可以通过使用
Variant
类型的变量而不是
String
来避免。但是更容易直接设置
rsTarget.myField=rsSource.myField
，中间没有变量。谢谢您的建议。我要试试看！我仍然需要在for循环之前更新第一条记录，对吗？我发现当我在for循环之前更新记录时，或者即使我根本不更新记录，程序也会一直运行直到停止响应。即使我使用以前的方法更新for循环之前的第一条记录，也会发生这种情况。“需要复制的其他许多字段”有多少？几十个？@HansUp:是的，几十个，虽然不到60个。我会用这个更新OP，这就是我担心的。假设总共有58个字段。这意味着对于每个重复的记录，您将重复已经存储的56个字段的信息——除了
ID
和
lob
之外的所有字段。如果你下定决心这么做，我相信安德烈的解决方案会成功的。但我鼓励您深入研究：“数据库规范化，或者简单的规范化，是组织关系数据库的列（属性）和表（关系）以最小化数据冗余的过程。”@HansUp:谢谢！我现在就读一读。看起来它真的可以帮助优化我的数据库。
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

strL3 = ![L3] & ""

![L3] = strL3

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