代码出错 - 产生相同的结果

时间:2017-11-17 01:54:17

标签: excel vba

我有这个我不完全理解的代码。它产生了同样的结果。

第一部分('返回超过250天的所有帐号)完美运行。它会记录上次付款日期大于250天的所有帐号,并将帐号和相应的天数返回到新工作表。

我需要接下来的两个部分(返回所有68岁及以上的帐号)和(返回所有小于18的帐号),以返回帐户持有人的年龄更大的帐号。等于68,小于18岁。

此代码为3个部分产生相同的结果。代码所采用的页面,使用的列是(' A'帐号,' E'自上次付款DSLP后的天数,以及' C'年龄)

提前致谢

'Populate the Recourse Items Sheet to provide the list of items for recourse

Dim DSLP As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1
Dim NewRange2 As Range
Dim MyCount2 As Long
MyCount2 = 1

'Return all the Account numbers that are greater than 250 days

    For Each DSLP In SFS.Range("E2:E" & LastRow)

        Select Case DSLP.Value

            Case Is > 250

                If MyCount = 1 Then
                    Set NewRange = DSLP.Offset(0, -4)

                Else
                   Set NewRange = Application.Union(NewRange, DSLP.Offset(0, -4))

                End If

               MyCount = MyCount + 1

'Return the corresponding days past 250

                If MyCount2 = 1 Then
                    Set NewRange2 = DSLP.Offset(0, -0)

                Else
                   Set NewRange2 = Application.Union(NewRange2, DSLP.Offset(0, -0))

                End If

               MyCount2 = MyCount2 + 1

        End Select

    Next DSLP

'Copy NewRange from inactive sheet into active sheet
 NewRange.Copy Destination:=RI.Range("A4")
 NewRange2.Copy Destination:=RI.Range("B4")

 Dim OLD As Range
 Dim NewRange3 As Range
 Dim MyCount3 As Long
 MyCount3 = 1
 Dim NewRange4 As Range
 Dim MyCount4 As Long
 MyCount4 = 1

'Return all the Account numbers that are 68 and older

    For Each OLD In SFS.Range("C2:C" & LastRow)

        Select Case OLD.Value

            Case Is >= 68

                If MyCount3 = 1 Then
                    Set NewRange3 = OLD.Offset(0, -2)

                Else
                   Set NewRange3 = Application.Union(NewRange3, OLD.Offset(0, -2))

                End If

               MyCount3 = MyCount3 + 1

'Return the corresponding ages 68 and older

                If MyCount4 = 1 Then
                    Set NewRange4 = OLD.Offset(0, -0)

                Else
                   Set NewRange4 = Application.Union(NewRange4, OLD.Offset(0, -0))

                End If

               MyCount4 = MyCount4 + 1

        End Select

    Next OLD

'Copy NewRange from inactive sheet into active sheet
    NewRange.Copy Destination:=RI.Range("D4")
    NewRange2.Copy Destination:=RI.Range("E4")

 Dim YOUNG As Range
 Dim NewRange5 As Range
 Dim MyCount5 As Long
 MyCount5 = 1
 Dim NewRange6 As Range
 Dim MyCount6 As Long
 MyCount6 = 1

'Return all the Account numbers that are younger than 18

    For Each YOUNG In SFS.Range("C2:C" & LastRow)

        Select Case YOUNG.Value

            Case Is < 18

                If MyCount5 = 1 Then
                    Set NewRange5 = YOUNG.Offset(0, -2)

                Else
                   Set NewRange5 = Application.Union(NewRange5, YOUNG.Offset(0, -2))

                End If

               MyCount5 = MyCount5 + 1

'Return the corresponding ages younger than 18

                If MyCount6 = 1 Then
                    Set NewRange6 = cell.Offset(0, -0)

                Else
                   Set NewRange4 = Application.Union(NewRange6, cell.Offset(0, -0))

                End If

               MyCount6 = MyCount6 + 1

        End Select

    Next YOUNG

'Copy NewRange from inactive sheet into active sheet
    NewRange.Copy Destination:=RI.Range("G4")
    NewRange2.Copy Destination:=RI.Range("H4")

0 个答案:

没有答案