Excel VBA質問箱 IV

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

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


13081 / 13646 ツリー ←次へ | 前へ→

【7118】コード番号を頼りに値を飛ばしたい ふぅ 03/8/23(土) 1:11 発言
【7120】Re:コード番号を頼りに値を飛ばしたい INA 03/8/23(土) 2:17 回答
【7121】Re:コード番号を頼りに値を飛ばしたい Hirofumi 03/8/23(土) 5:46 回答
【7146】Re:コード番号を頼りに値を飛ばしたい ふぅ 03/8/24(日) 1:12 お礼

【7118】コード番号を頼りに値を飛ばしたい
発言  ふぅ  - 03/8/23(土) 1:11 -

引用なし
パスワード
   sheet1のA列1行からランダムなコード番号があります。
sheet2のA列に000001から始まり、000100で終わるようなコード一覧があって、B列にそれぞれに対応した値があります。
sheet1のA列1行から読み込ませて、sheet1のB列にsheet2のコード一覧に対応した値を飛ばしたい場合、どのようなマクロを作ったらよいのでしょうか。
ご教示ください。


<sheet1>
 A列 *** B列

000001 ***【 3 】←ここにSheet2のコードに対応した値をB列に入れたい
000098 ***【  】


<sheet2>
A列 *** B列
000001 *** 3
000005 *** 5
000010 *** 8

【7120】Re:コード番号を頼りに値を飛ばしたい
回答  INA  - 03/8/23(土) 2:17 -

引用なし
パスワード
   作ってみましたので、試してみて下さい。

Private Sub CommandButton1_Click()
Dim C As Long
Dim FindData As Variant

With Worksheets("sheet1")

 'Sheet1のA列をデータの最下行までループ 
 For C = 1 To .Range("A65536").End(xlUp).Row
 
  'sheet1の値をFindで検索  
  Set FindData = _
Worksheets("sheet2").Range("A:A").Find(.Cells(C, 1).Value, LookAt:=xlWhole)
  
 '検索された右セルの値をsheet1のB列に代入
  .Cells(C, 2).Value = FindData.Offset(0, 1).Value

 Next C

End With
End Sub

【7121】Re:コード番号を頼りに値を飛ばしたい
回答  Hirofumi E-MAIL  - 03/8/23(土) 5:46 -

引用なし
パスワード
   こんな方法も有るよ
探索範囲、探索値、結果を配列に取っているので余り大きな物は無理が有るかも?

以下を同一の標準モジュールに記述して下さい

Public Sub Test()

  Dim i As Long
  Dim vntData As Variant
  Dim vntItem As Variant
  Dim vntResult As Variant
  
  'Sheet2のデータを探索範囲用配列に取得
  With Worksheets("Sheet2")
    vntData = Range(.Cells(2, 1), _
            .Cells(65536, 2).End(xlUp)).Value
  End With

  With Worksheets("Sheet1")
    'Sheet1の探索値を配列に取得
    vntItem = Range(.Cells(2, 1), _
            .Cells(65536, 1).End(xlUp)).Value
    '結果用の配列を確保
    ReDim vntResult(1 To UBound(vntItem, 1), 1 To 1)
    'Sheet1の探索値を探索範囲より二進探索し、
    '結果用配列に結果を代入
    For i = 1 To UBound(vntItem, 1)
      vntResult(i, 1) = RowSearch(vntItem(i, 1), vntData)
    Next i
    '結果用配列を出力
    .Range("B2").Resize(UBound(vntItem, 1)).Value = vntResult
  End With
    
End Sub

Private Function RowSearch(vntKey As Variant, _
              vntScope As Variant) As String

  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
    RowSearch = vntScope(lngMiddle, 2)
  Else
    RowSearch = ""
  End If
  
End Function

【7146】Re:コード番号を頼りに値を飛ばしたい
お礼  ふぅ  - 03/8/24(日) 1:12 -

引用なし
パスワード
   INA様、Hirofumi様

早速試しました所イメージ通りにすることが出来ました。
有難うございます。
本当に助かりました。
また何かありましたら宜しくお願い致します!

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