Excel VBA質問箱 IV

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

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


65267 / 76732 ←次へ | 前へ→

【16040】Re:別シートを次々処理したく
回答  Hirofumi  - 04/7/14(水) 21:40 -

引用なし
パスワード
   もし、「Sub DataSearch()」を使うなら
現状では、「Sub DataSearch()」を実行する度に
「参照シート.xls」がOpenされてCloseされます
因って、「Sub DataSearch()」を以下の様に修正して下さい
この場合、最後の「続けて処理を行いますか?」に「はい」を答えた場合、
マクロの有るBookが閉じられるまでの間、「参照シート.xls」がOpenされなく成ります

Public Sub DataSearch()

  Const lngRowEnd As Long = 65536
  
  Dim i As Long
  Static vntData As Variant
  Dim vntDataFile As Variant
  Dim blnExist As Boolean
  Dim strName As String
  Dim vntResult As Variant
  Dim vntKeys As Variant
  Dim rngKyes As Range
  
  
  'ファイルを指定する場合
'  vntDataFile = "C:\My Documents\参照シート.xls"
  vntDataFile = ThisWorkbook.Path & "\" & "VBATest397Data.xls"
  
  '画面更新の停止
  Application.ScreenUpdating = False
  
  'もし、参照用データが無いなら
  If VarType(vntData) <> vbArray + vbVariant Then
    strName = GetFileName(vntDataFile)
      With Workbooks
      For i = 1 To .Count
        If .Item(i).Name = strName Then
          blnExist = True
          Exit For
        End If
      Next i
      If blnExist Then
        .Item(strName).Activate
      Else
        '"参照シート"の有るファイルをOpen
        .Open (vntDataFile)
      End If
    End With
    'データを取得
    With Workbooks(strName).Worksheets("参照シート")
        vntData = Range(.Cells(2, "A"), _
          .Cells(lngRowEnd, "B").End(xlUp)).Value
    End With
    '入力ファイルをClose
    Workbooks(strName).Close
  End If
  
  'コードの有る範囲を設定
  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) = BinarySearch(vntKeys(i, 1), vntData)
  Next i
  
  '結果を出力
  With rngKyes
    .Offset(, 1).Resize(.Rows.Count).Value = vntResult
  End With
  
  Set rngKyes = Nothing
  
  Application.ScreenUpdating = True
  
  Beep
  If MsgBox("処理が完了しました" & vbCrLf _
      & "続けて処理を行いますか?", _
        vbExclamation + vbYesNo + vbDefaultButton1, _
                  "配列の保持") = vbNo Then
    vntData = Empty
  End If
    
End Sub

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 発言

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