Excel VBA質問箱 IV

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

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


53191 / 76732 ←次へ | 前へ→

【28360】Re:配列でのVlookupと転記について
回答  Hirofumi  - 05/9/3(土) 15:57 -

引用なし
パスワード
   少しは、速いかな?
顧客リストは、顧客番号の昇順で整列されている必要が有ります
また、「Option Compare Text」は必ず入れて下さい

Option Explicit
Option Compare Text

Public Sub Sample()

  Dim i As Long
  Dim rngSales As Range
  Dim vntSales As Variant
  Dim vntCustomer As Variant
  Dim vntResult As Variant
  Dim lngRows As Long
  
'  vntCustomer = WS2.Range(WS2.Cells(1, 1), WS2.Cells(7334, 2)).Value
  With Worksheets("顧客リスト").Cells(1, 1)
    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
    vntCustomer = .Resize(lngRows, 2).Value
  End With
  
  Set rngSales = Worksheets("売上データ").Cells(1, 1)
'  vntSales = WS1.Range(WS1.Cells(1, 1), WS1.Cells(20703, 2)).Value
  With rngSales
    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
    vntSales = .Resize(lngRows).Value
    ReDim vntResult(1 To lngRows, 1 To 1)
  End With
  
  For i = 1 To lngRows
'    ans = Application.WorksheetFunction.VLookup(vntSales(i, 1), vntCustomer, 2, False)
    vntResult(i, 1) = BinarySearch(vntSales(i, 1), vntCustomer)
  Next i
  
  Application.ScreenUpdating = False
  
  rngSales.Offset(, 1).Resize(lngRows).Value = vntResult

  Application.ScreenUpdating = True
  
  Set rngSales = Nothing
  
  Beep
  MsgBox "処理が完了しました"
  
End Sub

Private Function BinarySearch(ByVal vntKey As Variant, _
              ByVal vntScope As Variant) As Variant

'  二進探索

  Dim lngLow As Long
  Dim lngHigh As Long
  Dim lngMiddle As Long
  
  lngLow = LBound(vntScope, 1)
  lngHigh = UBound(vntScope, 1)
  
  Do While lngLow <= lngHigh
    lngMiddle = (lngLow + lngHigh) \ 2
    Select Case vntScope(lngMiddle, 1)
      Case Is < vntKey
        lngLow = lngMiddle + 1
      Case Is > vntKey
        lngHigh = lngMiddle - 1
      Case Is = vntKey
        lngLow = lngMiddle + 1
        lngHigh = lngMiddle - 1
    End Select
  Loop
  
  If lngLow = lngHigh + 2 Then
    BinarySearch = vntScope(lngMiddle, 2)
  Else
    BinarySearch = Empty
  End If

End Function
1 hits

【28359】配列でのVlookupと転記について yuhmo 05/9/3(土) 15:09 質問
【28360】Re:配列でのVlookupと転記について Hirofumi 05/9/3(土) 15:57 回答
【28361】Re:配列でのVlookupと転記について yuhmo 05/9/3(土) 16:07 お礼

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