离开这个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
答案 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