2017-07-06 3 views
0

私は、フィルタを列に適用し、保持しない値を選択して削除するExcelでマクロを使用しています。私が持っている問題は、私のマクロでは、私が望まないすべての価値を知る必要があるということです。現実には、私が保持したいものの定義されたリストがあり、他のものはすべて削除する必要があります。誰も私がそれを保持する値のリストを渡すことができるように、このマクロを周りに切り替えるのを助けることができる、他のすべてが削除されますか?ここに私がこれまで持っていたものがあります...すべてを削除する自動フィルタ

Columns("C:C").Select 
    Selection.AutoFilter 
    Dim LR As Long 
    LR = ActiveSheet.UsedRange.Rows.Count 
    ActiveSheet.Range("B2:B" & LR).AutoFilter Field:=1, Criteria1:=Array(_ 
     "A1", "AC", "AV", "BF", "BK", "BR", "C8", "CB", "CG", "CI", "CJ", "CM", "CO", "CR", "CS", "CT" _ 
     , "DR", "DN", "DS", "DU", "EF", "FC", "FE", "FI", "FO", "GD", "GE", "GO", "GR", "GW", "HA", "HD", _ 
     "HI", "KH", "KU", "LV", "MI", "MS", "MV", "MZ", "NE", "NO", "P4", "PI", "RS", "RT", "S9", "SC", "SU" _ 
     , "SY", "TO", "TX", "UR", "VN", "VR", "WI", "WN", "YA", "YO", "ZZ", "AO", "GS", "KR", "F5", "A2", _ 
     "LD", "ZE", "TG", "MX", "JI", "A9"), _ 
     Operator:=xlFilterValues 
    Rows("2:" & LR).Select 
    Selection.Delete Shift:=xlUp 
    Selection.AutoFilter 
    Range("A1").Select 

答えて

0

使用時のテンションシートがありそうです。

Dim LR As Long 
Dim rngDB As Range 
Dim Ws As Worksheet, Temp As Worksheet 
Set Ws = ActiveSheet 
LR = Ws.UsedRange.Rows.Count 
Set rngDB = ActiveSheet.Range("B2:B" & LR) 
rngDB.AutoFilter Field:=1, Criteria1:=Array(_ 
    "A1", "AC", "AV", "BF", "BK", "BR", "C8", "CB", "CG", "CI", "CJ", "CM", "CO", "CR", "CS", "CT" _ 
    , "DR", "DN", "DS", "DU", "EF", "FC", "FE", "FI", "FO", "GD", "GE", "GO", "GR", "GW", "HA", "HD", _ 
    "HI", "KH", "KU", "LV", "MI", "MS", "MV", "MZ", "NE", "NO", "P4", "PI", "RS", "RT", "S9", "SC", "SU" _ 
    , "SY", "TO", "TX", "UR", "VN", "VR", "WI", "WN", "YA", "YO", "ZZ", "AO", "GS", "KR", "F5", "A2", _ 
    "LD", "ZE", "TG", "MX", "JI", "A9"), _ 
    Operator:=xlFilterValues 

Set Temp = Sheets.Add 

rngDB.SpecialCells(xlCellTypeVisible).EntireRow.Copy Temp.Range("a1") 
Ws.ShowAllData 
rngDB.EntireRow.ClearContents 

Temp.Range("a1").CurrentRegion.Copy Ws.Range("a2") 
Application.DisplayAlerts = False 
Temp.Delete 
Application.DisplayAlerts = True 
0

すでに示されているように、一時的なシートを使用して正しい値を格納することができます。それ以外の場合は、select caseでちょうどそれを行くことができます。

Sub Filter() 
Dim lRow As Long 
Dim sht As Worksheet 

Set sht = Worksheets("Sheet1") 
lRow = sht.Cells(sht.Rows.Count, 2).End(xlUp).Row 

If lRow > 1 Then 
For i = lRow To 2 Step -1 
    Select Case sht.Cells(i, 2).Value 
    Case "A1", "AC", "AV", "BF", "BK", "BR", "C8", "CB", "CG", "CI", "CJ", "CM", "CO", "CR", "CS", "CT" _ 
     , "DR", "DN", "DS", "DU", "EF", "FC", "FE", "FI", "FO", "GD", "GE", "GO", "GR", "GW", "HA", "HD", _ 
     "HI", "KH", "KU", "LV", "MI", "MS", "MV", "MZ", "NE", "NO", "P4", "PI", "RS", "RT", "S9", "SC", "SU" _ 
     , "SY", "TO", "TX", "UR", "VN", "VR", "WI", "WN", "YA", "YO", "ZZ", "AO", "GS", "KR", "F5", "A2", _ 
     "LD", "ZE", "TG", "MX", "JI", "A9" 
    Case Else 
     sht.Rows(i).Delete 
    End Select 
Next 
End If 
End Sub 
関連する問題