| |
もし、「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
|
|
Hirofumi
- 04/7/14(水) 21:40 -
