循环多行的进程

时间:2018-03-01 14:50:55

标签: excel vba ms-access

我是VBA的新手,遇到了我认为应该是一个简单的解决方案。下面是我用来创建临时表的代码。代码是功能性的并按预期工作,但是,我想添加另一个级别。我想构建一个循环,为RsP中的多行重复此过程!记录。因此,如果我在rsP表中有3行,我想分别创建这3条记录。任何有关如何做到这一点的帮助将不胜感激,即使我确信答案就在我面前,我已经碰到了一堵砖墙。谢谢!

    Do Until (x = colCount)


    With rsNewRedacted

        .AddNew

            !A0 = rsP![Redacted ID]

            If (Right(rsP![Redacted / Redacted Name], 1) = "-") Then
                !A1 = Left(rsP![Redacted / Redacted Name], Len(rsP![Redacted / Redacted Name]) - 1) 
            Else
                !A1 = rsP![Redacted / Redacted Name]                                                
            End If

            rsI.AbsolutePosition = c.Item("01.06")
            !A5 = removeSpecialInclSpace(rsI("Col" & x))

            !A6 = Left(rsP![Redacted ID], 2)                                                     
            !A9 = rsP![MCC]                                                                     

            rsI.AbsolutePosition = c.Item("05.02")
            p0502 = rsI("Col" & x)
            !A10 = removeSpecial(rsI("Col" & x))                                                

            !A14 = rsDefRedacted![A14]                                                           
            !A16 = rsDefRedacted![A16]                                                           
            !A23 = rsDefRedacted![A23]                                                           

            rsI.AbsolutePosition = c.Item("02.12")                                              
            p0212 = removeSpecial(rsI("Col" & x))
            !A27 = p0212

            '!A27 = rsDefRedacted![A27]                                                           

            !A30 = rsDefRedacted![A30]                                                           

            rsI.AbsolutePosition = c.Item("01.16")
            !A53 = rsI("Col" & x)                                                               

            rsI.AbsolutePosition = c.Item("02.09")                                              
            !A56 = rsI("Col" & x)
            !A80 = rsI("Col" & x)

            rsI.AbsolutePosition = c.Item("02.10")                                              
            !A57 = rsI("Col" & x)
            !A81 = rsI("Col" & x)

            rsI.AbsolutePosition = c.Item("02.11")
            !A58 = rsI("Col" & x)                                                               
            !A82 = rsI("Col" & x)                                                               

            rsI.AbsolutePosition = c.Item("02.14")
            !A59 = rsI("Col" & x)                                                               

            rsI.AbsolutePosition = c.Item("01.19")
            ee = rsI("Col" & x)                                                                 

            If (Left(ee, 1) = "Y") Then
                !A71 = "Y"
            Else
                !A71 = "N"
            End If

            rsI.AbsolutePosition = c.Item("02.13")
            !A75 = rsI("Col" & x)                                                               


            rsI.AbsolutePosition = c.Item("07.13")
            p0713 = rsI("Col" & x)

            If (Left(p0713, 3) <> "n/a") And (p0713 <> "none") And (p0713 <> "no") Then         
                !A87 = p0713
            End If

            rsI.AbsolutePosition = c.Item("09.21")
            p0921 = rsI("Col" & x)

            If (Left(p0921, 1) = "y") Then                                                      
                !A99 = "Y"
            End If

            rsI.AbsolutePosition = c.Item("03.19")                                              
            p0319 = rsI("Col" & x)
            !A119 = p0319

            rsI.AbsolutePosition = c.Item("03.19")
            !A119 = removeSpecial(rsI("Col" & x))                                                         

            rsI.AbsolutePosition = c.Item("01.16")

            If (p0116 = "AUTO") Then
                rsI.AbsolutePosition = c.Item("02.25")
                p0225 = rsI("Col" & x)
                'A138 = removeSpecialInclSpace(p0225)
                A138 = p0225
            End If

        .Update

    End With

1 个答案:

答案 0 :(得分:1)

由于您的代码可能已经知道如何打开记录集,因此您可以使用以下框架迭代记录集中的记录:

Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("MyTable")

If Not rst.EOF Then ' If our recordset contains some records
    rst.MoveFirst ' Move the cursor to the first record in the set
    Do Until rst.EOF ' Do the following until we have reached the end of the recordset

        ' Do your thing

        rst.MoveNext ' Move the cursor to the next record in the recordset
    Loop
Else
    ' else the recordset was empty
End If