Excel VBA質問箱 IV

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

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


53562 / 76732 ←次へ | 前へ→

【27982】Re:userformでVLOOKUPってつかえるの?
回答  Hirofumi  - 05/8/25(木) 21:51 -

引用なし
パスワード
   VLookupでは有りませんが、こんなのでも出来ますよ?
このコードは、商品コードが昇順で整列している事を想定しています
もし、商品コードが整列されて居ない場合、以下を変更して下さい

    lngFound = RowSearchBin(CLng(SNumber.Text), rngCode, 1)

    lngFound = RowSearchBin(CLng(SNumber.Text), rngCode, 0)
にして下さい

以下をUserFormのコードモジュールに記述して下さい
尚、単価の表示の為、txtTankaと言うTextBoxを想定しています

Option Explicit

Private rngCode As Range

Private Sub SNumber_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

  Dim lngFound As Long
  Dim vntData As Variant
  
  'もし、データ範囲にデータが有り、SNumberが""で無いなら
  If (Not rngCode Is Nothing) And SNumber.Text <> "" Then
    '商品コードを探索
    '商品コードが数値として入力されている場合
    lngFound = RowSearchBin(CLng(SNumber.Text), rngCode, 1)
    '商品コードが文字列として入力されている場合
'    lngFound = RowSearchBin(SNumber.Text, rngCode, 1)
    '商品コードが有った場合
    If lngFound > 0 Then
      Shouhin.Text = rngCode.Item(lngFound, 2).Value
      txtTanka.Text = rngCode.Item(lngFound, 3).Value
    Else
      Cancel = True
      Beep
      MsgBox "該当コードが有りません"
      Shouhin.Text = ""
      txtTanka.Text = ""
    End If
  End If
  
End Sub

Private Sub UserForm_Initialize()

  Dim lngRows As Long
  
  '商品等のデーターの左上隅を基準とする(列見出しが有る場合)
  With Worksheets("Sheet1").Cells(1, "A")
    'データ行数を取得
    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
    If lngRows > 0 Then
      'データ範囲を設定
      Set rngCode = .Offset(1).Resize(lngRows)
    End If
  End With
  
  '商品等のデーターの左上隅を基準とする(列見出しが無い場合)
'  With Worksheets("Sheet1").Cells(1, "A")
'    'データ行数を取得
'    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
'    If lngRows >= 1 And .Value <> "" Then
'      'データ範囲を設定
'      Set rngCode = .Resize(lngRows)
'    End If
'  End With
  
End Sub

Private Sub UserForm_Terminate()

  Set rngCode = Nothing
  
End Sub

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

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

【27941】userformでVLOOKUPってつかえるの? 助けてください! 05/8/24(水) 21:07 質問
【27943】Re:userformでVLOOKUPってつかえるの? MARBIN 05/8/24(水) 21:35 回答
【27953】Re:userformでVLOOKUPってつかえるの? Jaka 05/8/25(木) 10:14 回答
【27963】Re:userformでVLOOKUPってつかえるの? 助けてください! 05/8/25(木) 14:39 質問
【27965】Re:userformでVLOOKUPってつかえるの? Jaka 05/8/25(木) 15:34 回答
【27982】Re:userformでVLOOKUPってつかえるの? Hirofumi 05/8/25(木) 21:51 回答

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