[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『リストボックスで指定した値を持たないセルを含む行を全て削除するマクロ』（kenj）
複数の全く同じテンプレートのシートの特定列から重複なく値を取り出したリストボックスから
複数の値を指定してボタンを押すとその値を持たないセルがある行を全て削除するマクロを作成しようとしています。
例）このように2枚のシートがあり(実際は数十枚あります)、データがはいっています。
男シート
AAA 田中 25 170 65
AAA 佐藤 30 178 70
BBB 鈴木 28 174 80
女シート
AAA 古川 24 158 50
BBB 小島 27 160 48
CCC 川野 28 164 54
一番左の列に入っている'AAA', 'BBB', 'CCC'という値をリストボックス(複数選択できる)に表示させる
ところまでは皆さんのお力を借りながら何とか自分の中で理解できる程度にはなりました。
今回はリストボックスに表示されている値のうち、
'AAA', 'CCC'を選択し、ボタンを押すと以下のように、'AAA', 'CCC'を値にもつセルがない行を削除させるような
動作をさせたいと思っています。
男シート
AAA 田中 25 170 65
AAA 佐藤 30 178 70
女シート
AAA 古川 24 158 50
CCC 川野 28 164 54
削除に関しては最近作ったものがあったので、以下のこのソースをベースになんとかしたいなとおもっています。
今回はワークシートだけを削除するのではなくてワークシート内部のセルを1つ1つ参照して削除するかしないかの
判断をすると思うのでもっと複雑になるだろうという予想をしています。
For idx = 0 To ListBox1.ListCount - 1
If Not ListBox1.Selected(idx) Then
ws2 = ListBox1.List(idx)
Worksheets(ws2).Delete
End If
Next idx
ListBoxは複数選択可能なため、ListBoxの値を引っ張ってくるのも繰り返しが必要だと思いますが、
複数のシートからセルの値を引っ張ってくるのにも繰り返しが必要だと思っていて、考えれば考えるほど混乱してきました。
上記の考え方で今回のマクロは組めますでしょうか。
また、どのように組めばよいでしょうか。
元々アルゴリズムを考えるのが苦手なのもあるので、こういう複雑な処理をする際にどこから考えていけば
良いのかというのもご教示いただければありがたいです。
これはシート１に文字列リンゴが存在するかを検索し、存在した場合。その位置を表示するソースです
これを参考にしてみてください
参考：http://excelvba.pc-users.net/fol7/7_1.html
Sub Search()
Dim lngYLine As Long
Dim intXLine As Integer
Dim Obj As Object
Set Obj = Worksheets("Sheet1").Cells.Find("りんご")
If Obj Is Nothing Then
MsgBox "りんごは見つかりませんでした。"
Else
lngYLine = Worksheets("Sheet1").Cells.Find("りんご").Row
intXLine = Worksheets("Sheet1").Cells.Find("りんご").Column
MsgBox "りんごは、" + CStr(lngYLine) + "行目の" _
+ CStr(intXLine) + "列目にあります"
End If
End Sub
（ten） 2013/10/30(水) 15:09
AAAとCCCの比較を行うのはFindメソッドを使うといいと思います
この比較というのはどういった意味でしょうか。
リストボックスに入っている値とセルの値を比較するという意味でしょうか。
Findメソッドを使うと
見つかったか見つからなかったかはわかると思いますが、
見つからなかった行全体を削除するというのをどのようにして実現するのか
考えてみましたがわかりません。
（kenj） 2013/10/30(水) 16:45
Private Sub CommandButton3_Click()
Dim lRow As Long Dim i As Long Dim ListV
For Each ws5 In ActiveWorkbook.Worksheets
'マクロを実行するためのボタンを配置しているシートは検索の対象から除外する
If ws5.Name <> "マクロ" Then
'最終行を設定
lRow = ws5.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
'最終行から1つずつ順に上に検索をして行く
For i = lRow To 2 Step -1
'リストボックスをリストボックスの要素の数だけインクリメントしながら繰り返し実行
For idx = 0 To ListBox2.ListCount - 1
'リストボックスの中身をListVに格納
ListV = ListBox2.List(idx)
'セルの値がListVの値と違えば、そのセルを含む行全体を削除する(E列に対象の列があるため5を設定)
If ws5.Cells(i, 5).Value <> ListV Then
Cells(i, 5).EntireRow.Delete
End If
Next idx
Next i
End If
Next ws5
Application.ScreenUpdating = True
End Sub
（kenj） 2013/10/30(水) 17:20
1) ListBox1には全ての値が存在する 2) 全ての対象シートの一行目に見出し列があり、データは2行目から
ということで
Dim i As Long, txt As String, ws As Worksheet
With Me.ListBox1
For i = 0 To .ListCount - 1
If Not .Selected(i) Then txt = txt & Chr(2) & .List(i)
Next
End With
If Len(txt) Then
For Each ws In Worksheets(Array("sheet1", "sheet2")) '<- 要変更
With ws.Cells(1).CurrentRegion
.AutoFilter 1, Split(Mid$(txt, 2), Chr(2)), xlFilterValues
.Offset(1).EntireRow.Delete
.AutoFilter
End With
Next
End If
（seiya） 2013/10/30(水) 17:42
2点不明点があります。
1.シート名を配列に詰め、ForEach文を回すという処理に関して
実はこの動作をさせる前に別のリストボックスで選択したシート以外のシートを全て削除するという操作をしています。一連の動作を全て説明させていただきます。（初期のファイルのシートの種類・枚数・名称は毎回同じです）
例：全て同じテンプレートのシートが10枚あるブックがある。
（Sheet1,Sheet2,Sheet3,Sheet4,Sheet5,Sheet6,Sheet7,Sheet8,Sheet9,Sheet10）
?@全てのシート名を取り込んだリストボックス(複数選択可能)でSheet1,Sheet2,Sheet5を選択し削除するボタンを押す。
Sheet1,Sheet2,Sheet5が残り、それ以外のシートは削除される。
?A残されたシート全てに対して特定列の項目（例えばE列の商品コード）を取り出し、リストボックス2(複数選択可能)に詰める。
?Bリストボックス2(複数選択可能)に表示されている項目（商品コード）の中から選択し、決定ボタンを押す。
?C全てのシートの全ての行に対し、選択した商品コードを含まない行が全て削除される。
これが処理の全容です。
?Bまではなんとかできていて、?Cだけを実現したいのですが、?Bの時点で残っているシートの数・名称は常に一定ではないので、提示いただいたArrayにシート名をそのまま詰めていくという方法では動作しないのではないかとおもっています。
要素数が可変のリストのようなものにシート名を格納し、リストの長さだけFor文を繰り返すような処理をさせるにはどのようにしたらよいでしょうか。
2.ご提示いただいたソースに関して
?Cの操作でリストボックス2で値を選択し、決定を押すと「RangeクラスのAutoFilterメソッドが失敗しました。というエラーがでます。
さらにリストボックス上にある全ての値を選択して決定を押した場合は、フィルタにかける対象がないからか
「型が一致しません。」というエラーが出るようになっています。
（kenj） 2013/10/31(木) 09:53
>?C全てのシートの全ての行に対し、選択した商品コードを含まない行が全て削除される。
> For Each ws In Worksheets(Array("sheet1", "sheet2")) '<- 要変更
を
For Each ws In Worksheets
に変更という話ですか？
（seiya） 2013/10/31(木) 11:50
AutoFilterの件に関してはいかがでしょうか。
何故エラーになるのかよくわかっていません。
（kenj） 2013/10/31(木) 12:40
どの時点/シートでエラーになるのでしょう？ （seiya） 2013/10/31(木) 13:23
Private Sub CommandButton3_Click()
Dim i As Long, txt As String, ws As Worksheet
Application.ScreenUpdating = False
With Me.ListBox2
For i = 0 To .ListCount - 1
If Not .Selected(i) Then txt = txt & Chr(2) & .List(i)
Next
End With
If Len(txt) Then
For Each ws In Worksheets
With ws.Cells(1).CurrentRegion
＞＞ .AutoFilter 1, Split(Mid$(txt, 2), Chr(2)), xlFilterValues
.Offset(1).EntireRow.Delete
.AutoFilter
End With
Next
End If
Application.ScreenUpdating = True
End Sub
＞＞の行でエラーになり、デバッグするかどうかの画面が呼び出されます。
（kenj） 2013/10/31(木) 15:24
1) シートは全て一行目もA列から列項目があり、データは2行目からになっていますか？ 2) step debugして、どのシートでエラーが起きるか確認してください。
If Len(txt) Then
For Each ws In Worksheets
Stop '<--挿入
ws.Activate '<-- 挿入
With ws.Cells(1).CurrentRegion
Stopの行でDebug モードになり、F8を押すごとに一行ずつ実行されます。 エラーになった時点でActiveになっているシートを確認してください。
同時に、変数 txt がどのようになっているかも確認してください。 カーソルを txt 上に移動すると表示されます。
（seiya） 2013/10/31(木) 16:31
P.S ファイルをアップしてもらえるなら http://www.sendspace.com/
txt = "┐┐U0E3OAQK"
アクティブなシートはWorksheet/Sheet7でした。
エラーメッセージはかわらず、1004 RangeクラスのAutoFilterメソッドが失敗しました。
です。
当初はSheet1でとまっており、その原因はご指摘どおりSheet1の1行目が空白セルだったためです。
（Sheet1は"マクロ"という名前のシートでマクロを実行させるボタンを配置しているのみのシートです）
シート名が"マクロ"でないときだけForEach文の処理をさせるようにしたら今度はSheet7でとまるようになってしまいました。
シートは"マクロ"を含めて6枚しかないのに7枚目にいっていてそもそも範囲外まで繰り返しを行っているのもおかしいと思うのですが、これはどうなっているのでしょうか。
（kenj） 2013/11/01(金) 10:09
> txt = "┐┐U0E3OAQK"
これ、ListBoxに空白行があるという意味です。
> If Not .Selected(i) Then txt = txt & Chr(2) & .List(i)
を
If (Not .Selected(i))*(.List(i) <> "") Then txt = txt & Chr(2) & .List(i)
に変更してみてください。 （seiya） 2013/11/01(金) 11:10
>シートは"マクロ"を含めて6枚しかないのに7枚目にいっていてそもそも範囲外まで繰り返しを行っているのもおかしいと思うのですが、これはどうなっているのでしょうか。
そのようなことはないと思いますが？
（seiya） 2013/11/01(金) 11:33
通常であれば2行目からは何かしらの数値が記入されているのですが、
そうなっていないシートもあるため、リストボックスに値を拾い上げるときに空白セルを拾い上げたのだと思います。
空白セルを除外する処理ができないか考えましたが、わからず、その時点では空白がリストボックスに追加されてしまうけども無視できる範囲だろうということでそのままにしていました。
ご提示いただいたとおりに変更してみましたが同じ箇所で同じエラーが起こってしまいます。
非常にごちゃごちゃしたコードにはなってしまっているかと思いますが、コードを添付させていただきます。
Private Sub CommandButton1_Click()
'エラー処理未完
Dim idx As Long
Dim ws2
'確認ダイアログボックスを非表示にする
Application.DisplayAlerts = False
'リストボックスの要素分チェックをする
For idx = 0 To ListBox1.ListCount - 1
'もし、選択されていないリストボックス要素だった場合は、削除する
If Not ListBox1.Selected(idx) Then
ws2 = ListBox1.List(idx)
Worksheets(ws2).Delete
End If
Next idx
ListBox1.Clear
'現在のブックのシート名を全てリストボックスの項目に設定する
intLoop = 0
For Each objSheet In ActiveWorkbook.Sheets
If Not objSheet.Name = "マクロ" Then
ListBox1.AddItem (objSheet.Name)
intLoop = intLoop + 1
End If
Next
With ListBox1 .MultiSelect = fmMultiSelectMulti End With
Application.DisplayAlerts = True
Set dic = CreateObject("Scripting.Dictionary")
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Range("A3").Value = "" Then
dt = ws.Range("A2").Resize(, 11)
Else
dt = ws.Range("A2", ws.Range("A2").End(xlDown)).Resize(, 11)
End If
For r = 1 To UBound(dt)
dic(dt(r, 5)) = True
Next
Next
For Each k In dic.keys
ListBox2.AddItem k
Next
Set dic = CreateObject("Scripting.Dictionary")
Dim ws3 As Worksheet
For Each ws3 In ActiveWorkbook.Worksheets
If ws3.Range("A3").Value = "" Then
dt = ws3.Range("A2").Resize(, 11)
Else
dt = ws3.Range("A2", ws3.Range("A2").End(xlDown)).Resize(, 11)
End If
For r = 1 To UBound(dt)
dic(dt(r, 11)) = True
Next
Next
For Each k In dic.keys
ListBox3.AddItem k
Next
With ListBox2 .MultiSelect = fmMultiSelectMulti End With With ListBox3 .MultiSelect = fmMultiSelectMulti End With
End Sub
Private Sub CommandButton2_Click()
Dim CpySaki As Workbook Dim CpyMoto As Workbook Dim Sht As Worksheet Dim MotoPath Dim xl_file
'コピー元ファイルのパス設定 MotoPath = TextBox1.Value
xl_file = ActiveWorkbook.Path & "\" & MotoPath '障害一覧ファイルを開く Set awb = Workbooks.Open(xl_file)
Set CpyMoto = Workbooks(MotoPath) Set CpySaki = ThisWorkbook
'コピー元ファイルのシートを一枚ずつ全てコピーして
'コピー先ファイルに新しくシートを作成しながら追加する
For Each Sht In CpyMoto.Worksheets
If Sht.Visible = True Then
Sht.Copy After:=CpySaki.Worksheets(CpySaki.Worksheets.Count)
ActiveSheet.Cells.Copy
ActiveSheet.Cells(1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End If
Next Sht
Dim intLoop As Integer
ListBox1.Clear
'現在のブックのシート名を全てリストボックスの項目に設定する
intLoop = 0
For Each objSheet In ActiveWorkbook.Sheets
If Not objSheet.Name = "マクロ" Then
ListBox1.AddItem (objSheet.Name)
intLoop = intLoop + 1
End If
Next
With ListBox1 .MultiSelect = fmMultiSelectMulti End With End Sub
Private Sub CommandButton3_Click()
Dim i As Long, txt As String, ws As Worksheet
Application.ScreenUpdating = False
With Me.ListBox2
For i = 0 To .ListCount - 1
If (Not .Selected(i)) * (.List(i) <> "") Then txt = txt & Chr(2) & .List(i)
Next
End With
If Len(txt) Then
For Each ws In Worksheets
If Not ws.Name = "マクロ" Then
Stop '<--挿入
ws.Activate '<-- 挿入
With ws.Cells(1).CurrentRegion
.AutoFilter 1, Split(Mid$(txt, 2), Chr(2)), xlFilterValues
.Offset(1).EntireRow.Delete
.AutoFilter
End With
End If
Next
End If
Application.ScreenUpdating = True
End Sub
'ListBox1にシート名を表示
Private Sub UserForm_Initialize()
Dim objSheet As Object Dim intLoop As Integer
'現在のブックのシート名を全てリストボックスの項目に設定する
intLoop = 0
For Each objSheet In ActiveWorkbook.Sheets
If Not objSheet.Name = "マクロ" Then
ListBox1.AddItem (objSheet.Name)
intLoop = intLoop + 1
End If
Next
With ListBox1 .MultiSelect = fmMultiSelectMulti End With End Sub
コマンドボタン2の処理はテキストボックス1にシートを取り込みたいファイルを指定してボタンを押すことで
このマクロが入っているファイルに取り込んだシートを挿入して、リストボックス1にそのシート一覧を表示します。
コマンドボタン1はリストボックス1で選択されていないシートを全て削除し、
選択されたシートに関しては特定の列の項目を重複なく取り出して、リストボックス2、3に追加します。
コマンドボタン3が現在やろうとしている処理です。
ここで質問させていただく際にはリストボックス2のみを例に挙げさせていただきましたが、本来はリストボックス2,3で同様の処理をしたいと思っています。
コマンドボタン3のイメージとしてはリストボックス2,3で選んだキー項目でフィルターをかけるイメージです。
（kenj） 2013/11/01(金) 11:57
今度はシートが4枚なのにも関わらず、Sheet9で処理がとまっていました。
もしかするとリストボックス1で取得した全てのシート名が配列としてwsに入っているのでは？
と思いました。
リストボックス1ではコマンドボタン2を実行していくつかのシートを削除した後、一度リストボックスの
中身を全てクリアして、残ったシート名のみを再度表示させているのですが、これでも削除前のもの(取得した全てのシートが表示されてしまう)が
適用されているのでしょうか。
（kenj） 2013/11/01(金) 12:06
まず 1) > For r = 1 To UBound(dt) > dic(dt(r, 5)) = True > Next は
For r = 1 To UBound(dt)
If dt(r,5) <> "" Then dic(dt(r, 5)) = True
Next
にすれば、空白行はなくなると思います。
2) > For Each k In dic.keys > ListBox2.AddItem k > Next が ListBox2, ListBox3 に其々ありますが
ListBox2.List = dic.keys
でOKですし、AddItemで処理すると、それより前の処理として ListBox2.Clear が必要になるでしょう。
3) セルが結合されているなんてことはありませんか？
もしそうでなければ、やはりファイルをアップして貰った方がわかりやすいと思います。 （seiya） 2013/11/01(金) 12:12
3に関しましては結合セルは一切ない状態です。
教えを乞うておりながら恐縮ですがデータ自体は外部持ち出し等ができない資料でして、
マクロのみのシートがあるものであればアップできるかと思います。
先ほどの投稿で記載しました仮定につきまして検証するために
取り込んだシートを前から2つを残して全部削除
マクロシート、一番目のシート、二番目のシートが残っている状態で
コマンドボタン3を押すと
次は今までWorksheet/Sheet1やらSheet7になっていた型がWorksheet/Worksheetになっていました。
（kenj） 2013/11/01(金) 12:39
＞＞ .AutoFilter 1, Split(Mid$(txt, 2), Chr(2)), xlFilterValues
でエラーですよね？
あと考えられることとしては、シートが保護されているくらいですかね... でもそれだとエラーメッセージでわかるし... （seiya） 2013/11/01(金) 13:01
確認しましたがシートは保護されていませんでした。
関係ないかもしれませんが
xlFilterValuesがEmpty値になっています。
（kenj） 2013/11/01(金) 13:11
>xlFilterValuesがEmpty値になっています。
xlFilterValues の実際の値は7です。 これはVBAで規定されたConst値なので、問題はありません。
そうなると、あとは実際のシート上に何か問題あるんだろうと思います。
ファイルにDummyのデータを埋め込んでアップして貰わないと、これ以上は無理です。 （seiya） 2013/11/01(金) 14:24
詳細な分析ありがとうございます。
シートをアップロードしましたので、ご覧いただければと思います。
http://www.sendspace.com/file/dopvi7
（kenj） 2013/11/05(火) 01:15
ファイルのアップありがとうございます。 どのような状況でエラーになるのでしょう？
実行してみましたが、エラーになりません。
ちなみに、E列でFilterですよね？ 1 を 5 に変更してください。
.AutoFilter 5, Split(Mid$(txt, 2), Chr(2)), xlFilterValues （seiya） 2013/11/05(火) 08:29
"マクロ"以外のシートを全て削除した状態から開始。(使用時の初期状態はこの状態のため)
↓
?@でファイル名を指定してコマンドボタン1を実行することで、指定したファイルの全てのシートを
"マクロ"のシートの次にコピー
↓
リストボックス1に表示されたシート(コピーしてきた全てのシート）の中から任意に複数（not全て）選択し、
決定
↓
リストボックス2にリストボックス1で選択した各シートのE列の要素が入るため、その中から任意に選択し、
決定
この手順の一番最後まではすんなりいくのですが、最後で例のAutoFilterメソッドエラーになります。
Editorを見ていて思ったのがこのケースでFor Each ws In Worksheetsというのは可能なのかということです。
最初コピーしてきたときが以下の状態。
マクロ(Sheet1)/シートA(Sheet2)/シートB(Sheet3)/シートC(Sheet4)/シートD(Sheet5)/シートE(Sheet6)/
シートA,C,Dを選択↓
マクロ(Sheet1)/シートA(Sheet2)/シートC(Sheet4)/シートD(Sheet5)
ここからWorksheetsの数だけ実行・・・ということができるのかなあと思いました。
本筋でなかったらすみません。
（kenj） 2013/11/05(火) 09:48
Hummmm... 問題なく機能しているようですけどねーー
開いたファイルのシートに問題があるのだったら、そのファイルもアップしてもらえば もしかしたらわかるかも知れませんが。
ちなみにCommandButton2のコードでファイル指定を手入力しているようですが ファイルは選択するようにした方が、間違いがないと思うので参考にしてください
Private Sub CommandButton2_Click()
Dim CpySaki As Workbook Dim CpyMoto As Workbook Dim Sht As Worksheet Dim MotoPath Dim xl_file As String
'コピー元ファイルのパス設定
MotoPath = TextBox1.Value
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path
xl_file = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If xl_file = "False" Then Exit Sub
TextBox1.Value = xl_file
'障害一覧ファイルを開く
Set CpyMoto = Workbooks.Open(xl_file) Set CpySaki = ThisWorkbook
'コピー元ファイルのシートを一枚ずつ全てコピーして
'コピー先ファイルに新しくシートを作成しながら追加する
For Each Sht In CpyMoto.Worksheets
If Sht.Visible = True Then
Sht.Copy After:=CpySaki.Worksheets(CpySaki.Worksheets.Count)
ActiveSheet.Cells.Copy
ActiveSheet.Cells(1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End If
Next Sht
Dim intLoop As Integer
ListBox1.Clear
'現在のブックのシート名を全てリストボックスの項目に設定する
intLoop = 0
For Each objSheet In ActiveWorkbook.Sheets
If Not objSheet.Name = "マクロ" Then
ListBox1.AddItem (objSheet.Name)
intLoop = intLoop + 1
End If
Next
With ListBox1 .MultiSelect = fmMultiSelectMulti End With End Sub （seiya） 2013/11/05(火) 10:18
今アップロードしたDummyで実行してみました。
確かに正常に動作しているケースもありましたが、
いくつかエラーが発生するケースがあります。
シート003が残っているケース(リストボックス2にA01とB01が表示されているケース）で
B01のみを選択して実行
リストボックス1にA01のみが表示されているケースで
何も選択せずに実行
以上のパターンでエラーが発生します。
リストボックスで順番が早い項目(A01)が選択されずに他のものが選択されるか、何も選択されていないケースでエラーが起きているとすると何が原因でしょうか？
（kenj） 2013/11/05(火) 10:41
>シート003が残っているケース(リストボックス2にA01とB01が表示されているケース）で >B01のみを選択して実行
その後 >リストボックス1にA01のみが表示されているケースで この状況が再現できません。 （seiya） 2013/11/05(火) 11:03
1.
シート003が残っているケース(リストボックス2にA01とB01が表示されているケース）で B01のみを選択して実行
2.何かしらのシートを選択して
リストボックス1にA01のみが表示されているケースで 何も選択せずに実行
1.2.ともにエラーが発生します。
どちらもエラーは出てないでしょうか？
（kenj） 2013/11/05(火) 11:06
1) ListBox1 で 003 を選択 → ListBox2 に A01, B01 が表示され B01 を選択
2) ListBox1 で 001 を選択 → ListBox2 に A001 が表示 何も選択しない
どちらの場合でも、CommadButton3 はエラー無しで機能していますが？
（seiya） 2013/11/05(火) 11:21
全く同じ条件で実行してみましたがどちらもエラーとなってしまいます。
エラー内容は例のAutoFilterメソッドです。
Excelのバージョンは2003なのですが、バージョンの関係なのでしょうか？
（kenj） 2013/11/05(火) 11:31
おっと、2003はCriteriaにArrayが使用できません、
Private Sub CommandButton3_Click()
Dim i As Long, txt As String, ws As Worksheet, e
Application.ScreenUpdating = False
With Me.ListBox2
For i = 0 To .ListCount - 1
If (Not .Selected(i)) * (.List(i) <> "") Then txt = txt & Chr(2) & .List(i)
Next
End With
If Len(txt) Then
For Each ws In Worksheets
If Not ws.Name = "マクロ" Then
'Stop '<--挿入
ws.Activate '<-- 挿入
With ws.Cells(1).CurrentRegion
For Each e In Split(Mid$(txt, 2), Chr(2))
.AutoFilter 5, e, xlFilterValues
.Offset(1).EntireRow.Delete
.AutoFilter
Next
End With
End If
Next
End If
Application.ScreenUpdating = True
End Sub
に変更してください。 （seiya） 2013/11/05(火) 11:39
変更させていただきましたが、やはりAutoFilterメソッドでエラーが発生します。
発生するのは先ほど申し上げたケースです。
AutoFilterに原因があるのかな？と思い調べたところこのような記述を見つけたのですが、いかがでしょうか。
http://officetanaka.net/excel/vba/tips/tips155.htm
このように、Excel 2003までは、1つの列を最大で2つの条件で絞り込むことしかできませんでした。それ が、Excel 2007から、1つの列を3つ以上の条件で絞り込むことが可能になりました。下図のデーで、A列 を"田中","鈴木","土屋"で絞り込んでみましょう。
（kenj） 2013/11/05(火) 11:49
私がアップしたコードは、一度に全てFilterするコードではありません。 ListBox2で選択されていない項目を一つづつFilterしているので、問題はないはずです。 （seiya） 2013/11/05(火) 11:56
「Field:=1」が「1列目」を表すのはいいですね。1つの列を3つ以上の条件で絞り込むには、上のように、引数Criteria1に、絞り込みたい条件を配列形式で指定し、さらに、引数Operatorに定数xlFilterValuesを指定します。この定数xlFilterValuesはExcel 2007で追加された定数ですので、Excel 2003以前で使用するとエラーになります。
先ほどのページ内にこんな記述がありました。
xlFilterValuesのエラーとみて間違いないでしょうか？
（kenj） 2013/11/05(火) 12:04
わわ
それ削除してください。 （seiya） 2013/11/05(火) 12:17
特定条件下でのエラーは解消されていませんが、通常使用であれば
エラーが出ることがないので、ひとまず満足に使用することができるようになりました。
使ったことのないメソッドも多々ご紹介いただき、なんとなくではありますが、自分のものにできたと思います。
ありがとうございました。
（kenj） 2013/11/06(水) 09:36
.xls の時点で気付くべきでしたね。 かなり遠回りしましたが、後学のためと思ってご容赦。 （seiya） 2013/11/06(水) 09:59
マクロのおかげでだいぶ作業が早くなってきました。
今回は勉強もかねて、機能の改良をしたいと思いまして、ご質問させていただきます。
現行のマクロの仕様はログ上に記載しています。
作業を行っているうちに、右下のリストボックス3にある特定の項目が入ったとき、
その項目は必ず選択の対象としていることに気づきました。
リストの要素数もたかがしれているので手動でやればいいといえばそれまでなのですが、
特定の項目である場合はリストボックス3に値を取得してきたあとに自動でその項目(複数可能)を最初から選択している状態にしたいと思っています。
リストボックス3に値を取得してきたあとに以下のような処理を書いてみました。
使い方を間違えているものばかりだと思いますが・・・。
イメージとしては「リストボックスの中身を1個ずつみていって、特定の項目が含まれていた場合に
その項目を選択する」という処理です。
'---------------------------------------------------------------------
For Each lb3 In ListBox3.List
If InStr("あああ", lb3) > 0 And InStr("いいい", lb3) > 0 Then
lb3.Select
End If
Next
'---------------------------------------------------------------------
（kenj） 2013/11/08(金) 20:39
多分、Or の方だと思いますが？ And だと両方を満たす必要がありますよ？
'For Each k In dic.keys
' ListBox3.AddItem k
'Next
ListBox3.List = dic.keys
With Me.ListBox3
.MultiSelect = fmMultiSelectMulti
For i = 0 To .ListCount - 1
If InStr(.List(i), "あああ") Or InStr(.List(i), "いいい") Then
.Selected(i) = True
End If
Next
End With
With ListBox2
.MultiSelect = fmMultiSelectMulti
End With
End Sub
（seiya） 2013/11/08(金) 21:42
そのとおりでした、Orですね。失礼しました。
なるほど、Selectedを使うのですね。booleanになっているのもしっかり頭になかったです。
ありがとうございます。
（kenj） 2013/11/08(金) 22:38
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.