Excel VBA質問箱 IV

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

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


11105 / 76735 ←次へ | 前へ→

【71171】Re:異なるデータを抽出させる
発言  kanabun  - 12/2/3(金) 11:59 -

引用なし
パスワード
   ▼PePe さん:

>Findは次の段階で勉強したいと思います。
>とりあえず、この種のコードをどのように書けば良いかと苦慮しています。

ある値が、ある範囲にあるかをLoopで範囲内の個々のセルにアクセスして
比較していくのは ばかサーチといって コードが難しいし、なによりセル
アクセスが頻繁に発生するのっで重い処理になります。
Findメソッドのほうがまだましです。コードも(内側のLoopがない分)
簡単になります。

Sub Findてすと() '------ Bk2の値が Bk1にあるか Find で調べる
 Dim i As Integer, k As Integer
 Dim LstR1 As Long, LstR2 As Long
 Dim Bk1 As Workbook, Bk2 As Workbook
 Dim v '←◆追加
 Dim r1 As Range '←◆追加
 Dim r2 As Range '←◆追加
 Dim c As Range '←◆追加
 
  Set Bk1 = ThisWorkbook
  Set Bk2 = Workbooks.Open(ThisWorkbook.Path & "\Book2.xlsx")

  With Bk1.Worksheets("sheet1")
   LstR1 = .Cells(Rows.Count, 1).End(xlUp).Row
   Set r1 = .Range("A1:A" & LstR1)
   LstR2 = Bk2.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
   'Bk2シートA列をLoop
   For Each r2 In Bk2.Sheets("Sheet1").Range("A1:A" & LstR2)
     v = r2.Value
     Set c = Nothing
     'Bk2シートA列のあるセル値が、Bk1側にあるか調べる
     Set c = r1.Find(v, LookIn:=xlFormulas, LookAt:=xlWhole)
     '↓無かった時の処理
     If c Is Nothing Then
       LstR1 = LstR1 + 1
       .Cells(LstR1, 1).Value = v
     End If
   Next r2
 End With
 
 Bk2.Close True
 Bk1.Save

End Sub
8 hits

【71162】異なるデータを抽出させる PePe 12/2/3(金) 10:36 質問
【71164】Re:異なるデータを抽出させる kanabun 12/2/3(金) 11:03 回答
【71167】Re:異なるデータを抽出させる PePe 12/2/3(金) 11:29 質問
【71168】Re:異なるデータを抽出させる Hirofumi 12/2/3(金) 11:31 発言
【71170】Re:異なるデータを抽出させる Hirofumi 12/2/3(金) 11:57 発言
【71172】Re:異なるデータを抽出させる Hirofumi 12/2/3(金) 12:42 発言
【71171】Re:異なるデータを抽出させる kanabun 12/2/3(金) 11:59 発言
【71166】Re:異なるデータを抽出させる kanabun 12/2/3(金) 11:21 発言
【71169】Re:異なるデータを抽出させる kanabun 12/2/3(金) 11:32 発言
【71173】Re:異なるデータを抽出させる PePe 12/2/3(金) 15:47 お礼
【71175】Re:異なるデータを抽出させる kanabun 12/2/3(金) 17:04 発言
【71176】Re:異なるデータを抽出させる kanabun 12/2/3(金) 18:29 発言
【71177】Re:異なるデータを抽出させる kanabun 12/2/3(金) 19:08 発言

11105 / 76735 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free