2016-08-05 238 views
2

我有一張有3張工作表的excel工作簿:限制,禁用和代碼。每天在A欄的代碼中,我會手動添加一個符號列表。我需要使用VBA在限制表單和禁用的表單中使用這兩個符號在代碼行中查看列A中的內容。如果股票在限制或禁用列表中,我需要VBA刪除該行。手動輸入到代碼中的符號列表可能每天都有所不同,所以我也需要使範圍動態化。結果應該是代碼片材的b欄中既不在限制列表中也不在禁用列表中的符號列表。如何使用VBA執行VLookup來比較兩個不同的表並刪除單元格表匹配的行?

下面是一個例子:

受限:AAA,BBB

禁用:CCC,DDD

代號(柱A):AAA,CCC,EEE,FFF,GGG

結果要求:

代碼(列b):EEE,FFF,GGG

+0

你試過了什麼 - 任何代碼? – jcoppens

回答

1

這使用數組並且相當快。

Sub foo() 
    Dim tickSht As Worksheet 
    Dim restSht As Worksheet 
    Dim disaSht As Worksheet 
    Dim tickArr() As Variant 
    Dim restArr() As Variant 
    Dim disaArr() As Variant 
    Dim outArr() As Variant 
    Dim i&, k&, j&, r&, d& 
    Dim dishr As Boolean 
    Dim tichr As Boolean 

    Set tickSht = ThisWorkbook.Worksheets("Tickers") 'ensure that this is the correct sheet name 
    Set restSht = ThisWorkbook.Worksheets("Restricted") 'ensure that this is the correct sheet name 
    Set disaSht = ThisWorkbook.Worksheets("Disabled") 'ensure that this is the correct sheet name 

    'load arrays 
    'if you have a title row then change the "A1" to "A2" or the first row. 
    'If your data is in a differect column then change the column. 
    With disaSht 
     disaArr = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Value 
    End With 

    With restSht 
     restArr = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Value 
    End With 
    r = Application.Evaluate("SUM(countifs(" & tickSht.Range("A1", tickSht.Cells(tickSht.Rows.Count, 1).End(xlUp)).Address & _ 
     "," & restSht.Range("A1", restSht.Cells(restSht.Rows.Count, 1).End(xlUp)).Address & "))") 
    d = Application.Evaluate("SUM(countifs(" & tickSht.Range("A1", tickSht.Cells(tickSht.Rows.Count, 1).End(xlUp)).Address & _ 
     "," & disaSht.Range("A1", disaSht.Cells(disaSht.Rows.Count, 1).End(xlUp)).Address & "))") 
    With tickSht 
     tickArr = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Value 
     ReDim outArr(1 To UBound(tickArr, 1) - d - t, 1 To 1) 
     k = 1 
     For i = LBound(tickArr, 1) To UBound(tickArr, 1) 
      dishr = False 
      tichr = False 
      For j = LBound(disaArr, 1) To UBound(disaArr, 1) 
       If disaArr(j, 1) = tickArr(i, 1) Then dishr = True 
      Next j 
      For j = LBound(restArr, 1) To UBound(restArr, 1) 
       If restArr(j, 1) = tickArr(i, 1) Then tichr = True 
      Next j 
      If Not tichr And Not dishr Then 
       outArr(k, 1) = tickArr(i, 1) 
       k = k + 1 
      End If 
     Next i 
     .Range("B1").Resize(UBound(outArr, 1), 1).Value = outArr 
    End With 

End Sub 

這假定數據在所有三張表的A列中,並且沒有標題行。如果不同,那麼需要進行一些調整。

這是動態的,因爲它始終會發現所有三張​​紙上的數據範圍都會將它們加載到數組中並遍歷這些數據。

數組的使用限制了vba在excel中訪問工作表的次數,因此對於較大的數據集它會更快。

+0

這工作完美!謝謝! @scottCraner – eliza0521

+0

現在返回一個錯誤,表示運行時錯誤「9」:下標超出範圍@scottCraner。 – eliza0521

+0

哪一個,第一個還是編輯?我添加了兩個Application.Evaluates。 –

相關問題