Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
2178 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【69526】別シートの項目を削除するには？ gin 11/7/28(木) 13:11 質問[未読]
【69527】Re:別シートの項目を削除するには？ Yuki 11/7/28(木) 15:34 発言[未読]
【69531】Re:別シートの項目を削除するには？ gin 11/7/28(木) 21:41 質問[未読]
【69540】Re:別シートの項目を削除するには？ Yuki 11/7/29(金) 18:27 発言[未読]
【69532】Re:別シートの項目を削除するには？ yuto 11/7/28(木) 22:21 発言[未読]
【69534】Re:別シートの項目を削除するには？ gin 11/7/29(金) 10:04 質問[未読]
【69535】Re:別シートの項目を削除するには？ gin 11/7/29(金) 10:06 お礼[未読]
【69541】Re:別シートの項目を削除するには？ kanabun 11/7/30(土) 9:37 発言[未読]
【69526】別シートの項目を削除するには？
質問  gin  - 11/7/28(木) 13:11 -
引用なし
パスワード
   いつもお世話になります。
中々初心者レベルから上達しませんので何方か教えて下さいませ。
sheet(1)のA列に
1.a
2.c
3.f
4.g
の様にランダムな項目が有　項目数も変わります。
（実際は項目は70以上あります）
sheet(2)のA列に
1.a
2.b
3.d
4.e
5.f
↓
26.ｚ
の様に項目が全てあります。
（実際には3000以上の項目があります）
このsheet(2)のA列の項目からsheet(1)の項目行を削除する場合
私に考え付くのは
Sub test()
　　Dim vl As String
　　Worksheets(1).Select
　　Range("A1").Select
　　vl = ActiveCell.Value
　　Do Until vl = ""
　　　　Sheets(2).Select
　　　　Range("A1").Select
　　　　Do Until ActiveCell.Value = ""
　　　　　　If ActiveCell.Value = vl Then
　　　　　　　　ActiveCell.EntireRow.Delete
　　　　　　Else
　　　　　　　　ActiveCell.Offset(1).Select
　　　　　　End If
　　　　Loop
　　　　Sheets(1).Select
　　　　ActiveCell.Offset(1).Select
　　　　vl = ActiveCell.Value
　　Loop
End Sub
の様に書いています。
しかし、何度もシートを開いてマクロを実行する為
目まぐるしいですし時間もかかります。
もっとスマートな方法をご教授下さい。
宜しくお願いします。
【69527】Re:別シートの項目を削除するには？
発言  Yuki  - 11/7/28(木) 15:34 -
引用なし
パスワード
   ▼gin さん：
こんにちは。
１行目はタイトル行として(AutoFilter使用のため)
又使用していない列があるものとして（作業列として使用)
下記の方法ではどうでしょう。

Sub TESTc()
　　Dim v1　As Variant
　　Dim v2　As Variant
　　Dim i　 As Long
　　Dim j　 As Long
　　Dim Dic As Object
　　v1 = Worksheets("Sheet2").Range("A1").CurrentRegion.Resize(, 1).Value
　　v2 = Worksheets("Sheet1").Range("A1").CurrentRegion.Resize(, 1).Value
’Sheet2をディクショナリに登録
　　Set Dic = CreateObject("Scripting.Dictionary")
　　For i = 1 To UBound(v1)
　　　　Dic(v1(i, 1)) = Empty
　　Next
' 存在チェック
　　For i = 1 To UBound(v2)
　　　　If Dic.Exists(v2(i, 1)) Then
' 合ったら "DeleteRow" に置き換え(Sheet1の値と重複しなければなんでもOK)
　　　　　　v2(i, 1) = "DeleteRow"
　　　　End If
　　Next
　　With Worksheets("Sheet1")
　　　　.AutoFilterMode = False
' 空いている列（作業列）にチェックした値を貼付け　
　　　　.Range("D1").Resize(UBound(v2)).Value = v2
' AutoFilterをかける
　　　　With .Range("D1").CurrentRegion.Resize(, 1)
　　　　　　.AutoFilter Field:=1, Criteria1:="DeleteRow"
' 可視行を削除
　　　　　　.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
　　　　End With
　　　　.AutoFilterMode = False
　　　　.Columns(4).ClearContents
　　End With
End Sub
【69531】Re:別シートの項目を削除するには？
質問  gin  - 11/7/28(木) 21:41 -
引用なし
パスワード
   yukiさん　有難う御座います。
実際に同じ様に記入してみたのですが
シート２のデータからシート１の項目が
削除されませんでした。

オートフィルターで削除するのは
なんとなくわかるような気がするのですが
ディクショナリーとかUBound
について教えていただけませんか？
【69532】Re:別シートの項目を削除するには？
発言  yuto  - 11/7/28(木) 22:21 -
引用なし
パスワード
   こんばんは。

この手の処理ですと「画面の更新を行わない」をキーワードにすれば
適切な過去ログが出てきそうですね。
また、ActiveやSelectを毎回行わないというのも定番の回答な気がします。

Yukiさんとは別案を（速度的にはイマイチな気もしますが…）
とりあえず書いてみたのでのせてみます。

Sub test()
　　Const StartRow& = 2
　　Dim LastRow&, i&, RetCnt%
　　Dim Rn As Range
　　
　　With Sheets(1)
　　　　Set Rn = .Range(.Cells(1, 1), _
　　　　　　　　 .Cells(.Cells(65526, 1).End(xlUp).Row, 1))
　　End With
　　With Sheets(2)
　　　　.Select
　　　　LastRow = .Cells(65526, 1).End(xlUp).Row
　　　　For i = LastRow To StartRow Step -1
　　　　　　With .Cells(i, 1)
　　　　　　　　RetCnt = Application.WorksheetFunction.CountIf(Rn, .Text)
　　　　　　　　If (RetCnt <> 0) Then
　　　　　　　　　　.Interior.ColorIndex = 6　
　　　　　　　　　　'Delete 処理の変わりに色をつけてみる。
　　　　　　　　End If
　　　　　　End With
　　　　Next i
　　End With
End Sub
【69534】Re:別シートの項目を削除するには？
質問  gin  - 11/7/29(金) 10:04 -
引用なし
パスワード
   yuto さん

このコードなら私にも解りました。
とてもシンプルで良いですね。

他にも応用が出来そうなので
活用させてもらいます。

過去ログ等を見てみましたが
ActiveやSelectを毎回行わないと
画面がそのままなんですね。
勉強になりました。

有難う御座いました。
【69535】Re:別シートの項目を削除するには？
お礼  gin  - 11/7/29(金) 10:06 -
引用なし
パスワード
   ごめんなさい
前の書き込みは
問ではなくお礼でした。
【69540】Re:別シートの項目を削除するには？
発言  Yuki  - 11/7/29(金) 18:27 -
引用なし
パスワード
   ▼gin さん：
>実際に同じ様に記入してみたのですが
>シート２のデータからシート１の項目が
>削除されませんでした。

一行も削除されなかったのですか？
ご提示のデータにタイトル行を追加してテストしたら
ｃ
ｇ
が残りましたけど。

>
>オートフィルターで削除するのは
>なんとなくわかるような気がするのですが
>ディクショナリーとかUBound
>について教えていただけませんか？

今回のディクショナリは見出し付きの辞書みたいなものです。

例えばShet2のA列
1.a
2.b
3.d
4.e
5.f

この時 d を探そうとするとLoopさせて
1 a
↓
2 b
↓
3 d　此処にあった

ディクショナリだと
いきなり
d があったになります。

UBoundについてはHelpにのっておりますので見てください。
配列の次元数です。
【69541】Re:別シートの項目を削除するには？
発言  kanabun  - 11/7/30(土) 9:37 -
引用なし
パスワード
   ▼gin さん：
こんにちは〜

>しかし、何度もシートを開いてマクロを実行する為
>目まぐるしいですし時間もかかります。
については、すでにアドバイスのあるように Selectしない！方針で。


あと、
行削除は重い処理なので、できれば、一括して、削除でなく、
該当行をクリアすることで対応したい。
ということで、作業列を使って削除行を表の下方に集め、一括クリアする
方法をご紹介します。

Option Explicit

Sub Try1()
　　'Sheet1.A列削除リスト　アドレス
　　Dim Address As String
　　With Worksheets(1)
　　　　Address = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) _
　　　　　　.Address(1, 1, xlR1C1, True)
　　End With
　　
　
　　'Sheet2.B列に数式書き込み
　　With Worksheets(2).Range("A1").CurrentRegion.Resize(, 2)
　　　　.Columns(2).FormulaR1C1 _
　　　　　　= "=IF(ISERROR(MATCH(RC[-1]," & Address & ",0)),False,1)"
　　　　'B列でソート
　　　　.Sort Key1:=.Columns(2), Header:=xlNo
　　　　'不要行をクリア （最低1行は該当行があるものと仮定）
　　　　.Columns(2).SpecialCells(xlCellTypeFormulas, xlLogical) _
　　　　　　.EntireRow.Clear
　　　　'B列をクリア
　　　　.Columns(2).Clear
　　End With
　　
End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
2178 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free