Excel VBAa IF值在数组Do While Loop中

时间:2016-07-01 16:56:25

标签: arrays excel vba excel-vba

离开这个post我试图测试一个数组中的值是否在另一个数组中,如果是这样的话,要切割行并移动到另一个名为Sheets("Exclusions")的表格但是我是得到一个没有循环错误,但我相信我有正确的syntax

Sheets("Main").Activate

LR = Range("a1000").End(xlUp).Row
LC = 3 'Range("zz1").End(xlToLeft).Column


        cName = "Sec ID"
        cA = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column

         ReDim aCheck(1 To LR, 1 To LC)


                For i = 2 To LR
                        aCheck_Row = aCheck_Row + 1
                            aCheck(aCheck_Row, 1) = cells(i, cA)             'Security 

'''' Does not Work                     
'                            If aCheck(aCheck_Row, 1) = Yet_Another_array(Yet_Another_array_Row, 1) Then
'                            Debug.Print ("Y")
                        Do
                            If IsError(Application.Match(aCheck(aCheck_Row, 1), Yet_Another_array, 0)) Then
                            MsgBox "Found"

                            Dim ASR As Worksheet, LS As Worksheet

                            Set ASR = ActiveWorkbook.Sheets("Main")
                            Set LS = ActiveWorkbook.Sheets("Exclusions")
                             ASR.cells(i, "C").EntireRow.Cut Destination:=LS.Range("A" & LS.Rows.Count).End(xlUp).Offset(1)

                            Exit Do

                        Loop While Not IsEmpty(aCheck)

我也在努力尝试从这里找出切割和过去的代码 Excel Macro To Cut Rows And Paste Into Another Worksheet

完整代码(很多)

Sub Import_CSV()
Dim WrdArray() As String
Dim line As String
Dim clm As Long
Dim Rw As Long


Application.ScreenUpdating = False

Sheets("Macro").Select
RB_import = Application.cells(21, 4)
'File_Loc = Cells(21, 4)

Set txtstrm = FSO.OpenTextFile(RB_import)
Sheets("RB").Visible = True
Sheets("RB").Activate
Range("A:DA").Select
Selection.ClearContents
Rw = 1
Do Until txtstrm.AtEndOfStream
  line = txtstrm.ReadLine
  clm = 1
  WrdArray() = Split(line, "|")
  For Each wrd In WrdArray()
    ActiveSheet.cells(Rw, clm) = wrd
    clm = clm + 1
  Next wrd
  Rw = Rw + 1
Loop
txtstrm.Close
Rows("1:28").Select
Selection.Delete Shift:=xlUp 'deletes generic header info from .req files
Range("A:DA").Select
Selection.NumberFormat = "@"


    '-----Creates Temp Source to loop through--------------------------------------------------------
        LR = Range("a65000").End(xlUp).Row
        LC = 15
        ReDim Source(1 To LR, 1 To LC)
        Source = Range(cells(1, 1), cells(LR, LC))
        'tempbk.Close SaveAs = False
    '------------------------------------------------------------------------------------------------
Dim a As Range
rbRow = 0

For r = 1 To LR
    rbRow = rbRow + 1
    aRB_Return_Import(rbRow, 1) = Source(r, 1) 'security ID
    aRB_Return_Import(rbRow, 2) = Source(r, 4) 'PX_OPEN
    aRB_Return_Import(rbRow, 3) = Source(r, 5) 'PX_LAST
    aRB_Return_Import(rbRow, 4) = Source(r, 6) 'CHG_PCT_1D
    'aRB_Return_Import(rbRow, 5) = Source(r, 7) 'net rate
'
'  If RB_List.Exists(aRB_Return_Import(Row, 3)) Then
'    TempArray(Row, 18) = Sec_id_dic(TempArray(Row, 3))
'  End If





Next r

'Sheets("RB").Visible = False
'Sheets("RB_Return").Select
Sheets("Recon").Select

'Range("a2:i" & rbRow) = aRB_Return_Import
Range("G2:i" & rbRow) = aRB_Return_Import
'Range("G2") = aRB_Return_Import

'Range("D2").Select
'    Range(Selection, Selection.End(xlDown)).Select
'    Selection.Style = "Percent"
'    Selection.NumberFormat = "0.00%"

LR = Range("a1000").End(xlUp).Row
LC = 30 'Range("zz1").End(xlToLeft).Column


        cName = "Security"
        cA = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
        cName = "Current Price"
        cB = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
        cName = "Prior Price"
        cC = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
        cName = "Change Price (%)"
        cD = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
        cName = "Check"
        cE = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "Price Date"
'        cF = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "Current Price"
'        cG = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "Prior Price"
'        cH = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "Change Price (%)"
'        cI = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "BPS Impact"
'        cJ = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "Source"
'        cK = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "Source"

        ReDim aRecon(1 To LR, 1 To LC)
        ReDim Yet_Another_array(1 To 200, 1 To 20)


                For i = 2 To LR
                        aRecon_Row = aRecon_Row + 1
                            aRecon(aRecon_Row, 1) = CStr(cells(i, cA))      'Security 'previously was fund #
                            aRecon(aRecon_Row, 2) = cells(i, cB)            'Current Price
                            aRecon(aRecon_Row, 3) = cells(i, cC)            'Prior Price
                            aRecon(aRecon_Row, 4) = cells(i, cD)            'Change Price (%)
                             On Error GoTo ErrorHandler
                            If (aRecon(aRecon_Row, 2) - aRecon(aRecon_Row, 3)) / aRecon(aRecon_Row, 3) <> 2 Then 'aRB_Return_Import(rbRow, 4) Then
                                       aRecon(aRecon_Row, 5) = "Pass"            'CHeck Pass or Fail
                                       Yet_Another_array_Row = Yet_Another_array_Row + 1
                                       Yet_Another_array(Yet_Another_array_Row, 1) = aRecon(aRecon_Row, 1)
                            Else
ErrorHandler:
                                       aRecon(aRecon_Row, 5) = "Fail"            'CHeck Pass or Fail
                            End If


'                            aRecon(aRecon_Row, 6) = Cells(i, cF)            'Price Date
'                            aRecon(aRecon_Row, 7) = Cells(i, cG).Value      'Current Price
'                            'Debug.Print aRecon_Row
'                            aRecon(aRecon_Row, 8) = Cells(i, cH).Value      'Prior Price
'                            aRecon(aRecon_Row, 9) = Cells(i, cI)            '
'                            aRecon(aRecon_Row, 10) = Cells(i, cJ)           'BPS Impact
'                            aRecon(aRecon_Row, 11) = Cells(i, cK)           'Source
'                            aRecon(aRecon_Row, 12) = Cells(i, cL)           'SSIMS - Comment

                Next i

Set Destination = Range("L2")
Destination.Resize(UBound(aRecon, 1), UBound(aRecon, 2)).Value = aRecon

Set Destination = Range("T2")
Destination.Resize(UBound(Yet_Another_array, 1), UBound(Yet_Another_array, 2)).Value = Yet_Another_array

Sheets("Main").Activate

LR = Range("a1000").End(xlUp).Row
LC = 3 'Range("zz1").End(xlToLeft).Column


        cName = "Sec ID"
        cA = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column

         ReDim aCheck(1 To LR, 1 To LC)


                For i = 2 To LR
                        aCheck_Row = aCheck_Row + 1
                            aCheck(aCheck_Row, 1) = cells(i, cA)      'Security 'previously was fund #
                            'aCheck(aCheck_Row, 2) = Cells(i, cB)            'Current Price
                            'aCheck(aCheck_Row, 3) = Cells(i, cC)            'Prior Price

'                            If aCheck(aCheck_Row, 1) = Yet_Another_array(Yet_Another_array_Row, 1) Then
'                            Debug.Print ("Y")
'                            End If

                            Do
                                If IsError(Application.Match(aCheck(aCheck_Row, 1), Yet_Another_array, 0)) Then
                                MsgBox "Found"

                                Dim ASR As Worksheet, LS As Worksheet

                                Set ASR = ActiveWorkbook.Sheets("Main")
                                Set LS = ActiveWorkbook.Sheets("Exclusions")
                                 ASR.cells(i, "C").EntireRow.Cut Destination:=LS.Range("A" & LS.Rows.Count).End(xlUp).Offset(1)

                                Exit Do

                            Loop While Not IsEmpty(aCheck)



                Next i




Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:1)

我不确定你在哪里得到错误(哪一行),但是我会把工作表声明和设置放在循环之外(以减少代码运行时)。

ReDim aCheck(1 To LR, 1 To LC)

Dim ASR As Worksheet, LS As Worksheet

Set ASR = ActiveWorkbook.Sheets("Main")
Set LS = ActiveWorkbook.Sheets("Exclusions")

For i = 2 To LR
    aCheck_Row = aCheck_Row + 1
    aCheck(aCheck_Row, 1) = Cells(i, cA)      'Security 'previously was fund #
    'aCheck(aCheck_Row, 2) = Cells(i, cB)     'Current Price
    'aCheck(aCheck_Row, 3) = Cells(i, cC)     'Prior Price

    '                            If aCheck(aCheck_Row, 1) = Yet_Another_array(Yet_Another_array_Row, 1) Then
    '                            Debug.Print ("Y")
    '                            End If

    Do
        If IsError(Application.Match(aCheck(aCheck_Row, 1), Yet_Another_array, 0)) Then
            MsgBox "Found"
            ASR.Cells(i, "C").EntireRow.Cut Destination:=LS.Range("A" & LS.Rows.count).End(xlUp).Offset(1)
        End If
        Exit Do

    Loop While Not IsEmpty(aCheck)

Next i