Excel VBA質問箱 IV

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

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


65405 / 76732 ←次へ | 前へ→

【15902】別シートを次々処理したく
回答  Hirofumi  - 04/7/11(日) 11:31 -

引用なし
パスワード
   >この現在使用しているシートのみでなく、
>別シートを次々処理したく、

と言う事なら、発想を変えて、こんなのでも言いと思いますが?
今度は、以下のコードを「**参照シート**」の有るBookの標準モジュールに記述して下さい
まず、「**参照シート**」の有るBookを開きます
次に、処理したいBookを開き、処理したいシートをActiveにします
「DataSearch2」を実行します
処理したBookを閉じ、次に処理したいBookを開き同様にします

Option Explicit

Public Sub DataSearch2()

  Const lngRowEnd As Long = 65536
  
  Dim i As Long
  Dim rngData As Range
  Dim vntResult As Variant
  Dim vntKeys As Variant
  Dim rngKyes As Range
  
  
  '画面更新の停止
  Application.ScreenUpdating = False
  
  'データ範囲を取得
  With ThisWorkbook.Worksheets("参照シート")
    Set rngData = Range(.Cells(2, "A"), _
        .Cells(lngRowEnd, "A").End(xlUp))
  End With
  
  'コードの有る範囲を設定
  With ActiveSheet
    Set rngKyes = Range(.Cells(2, "A"), _
            .Cells(lngRowEnd, "A").End(xlUp))
  End With
  'コードを配列に取得
  vntKeys = rngKyes.Value
  '結果用配列を確保
  ReDim vntResult(1 To UBound(vntKeys, 1), 1 To 1)
  
  'コードの先頭から終りまで繰り返し
  For i = 1 To UBound(vntKeys, 1)
    'コードを探索
    vntResult(i, 1) = RowSearchBin(vntKeys(i, 1), rngData)
  Next i
  
  '結果を出力
  With rngKyes
    .Offset(, 1).Resize(.Rows.Count).Value = vntResult
  End With
  
  Set rngKyes = Nothing
  Set rngData = Nothing
  
  Application.ScreenUpdating = True
  
  Beep
  MsgBox "処理が完了しました"
    
End Sub

Private Function RowSearchBin(vntKey As Variant, _
            rngScope As Range) As Variant

  Dim vntFind As Variant
  Dim lngDataTop As Long
  
  'Matchによる二分探索
  vntFind = Application.Match(vntKey, rngScope, 1)
  'もし、エラーで無いなら
  If Not IsError(vntFind) Then
    'もし、Key値と探索位置の値が等しいなら
    If vntKey = rngScope(vntFind).Value Then
      '戻り値として、行位置を代入
      RowSearchBin = rngScope(vntFind, 2).Value
    End If
  End If
  
End Function

4 hits

【15876】データ抽出について 初心者 04/7/9(金) 23:12 質問
【15879】Re:データ抽出について Asaki 04/7/9(金) 23:30 回答
【15886】Re:データ抽出について Asaki 04/7/10(土) 13:31 回答
【15881】Re:データ抽出について Hirofumi 04/7/10(土) 0:42 回答
【15890】Re:データ抽出について 初心者 04/7/10(土) 21:30 質問
【15891】Re:データ抽出について かみちゃん 04/7/10(土) 22:10 回答
【15892】Re:データ抽出について Hirofumi 04/7/10(土) 23:13 回答
【15898】Re:データ抽出について 初心者 04/7/11(日) 9:39 質問
【15901】Re:データ抽出について Hirofumi 04/7/11(日) 10:57 回答
【15902】別シートを次々処理したく Hirofumi 04/7/11(日) 11:31 回答
【15982】Re:別シートを次々処理したく 初心者 04/7/13(火) 21:26 質問
【15984】Re:別シートを次々処理したく Hirofumi 04/7/13(火) 21:59 回答
【16040】Re:別シートを次々処理したく Hirofumi 04/7/14(水) 21:40 回答
【16116】Re:別シートを次々処理したく 初心者 04/7/16(金) 20:48 お礼
【16207】Re:別シートを次々処理したく 以前の続き... 初心者 04/7/20(火) 21:28 質問
【16208】Re:別シートを次々処理したく 以前の続き... Hirofumi 04/7/20(火) 21:59 発言
【16214】Re:別シートを次々処理したく 以前の続き... 初心者 04/7/21(水) 6:30 発言
【16241】Re:別シートを次々処理したく 以前の続き... Hirofumi 04/7/21(水) 21:04 回答
【16309】Re:別シートを次々処理したく 以前の続き... 初心者 04/7/24(土) 22:28 お礼
【15897】Re:データ抽出について @MS1 04/7/11(日) 9:28 発言

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