Excel VBA質問箱 IV

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

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


53315 / 76732 ←次へ | 前へ→

【28233】Re:match関数について
回答  Hirofumi  - 05/8/31(水) 21:12 -

引用なし
パスワード
   >ちなみに、
>>この値がセルA1〜F1にあったとします。
>この部分を検索範囲とし
>
>>検索値は A2
>この部分をTextbox1
>
>>数式を入れるセルをB2とすると、
>この部分をTextbox2
>とした場合にマクロとして記述することはできるのでしょうか?

此れがUserFormのTextBoxでと言う事なら以下の様に成ります

以下をUserFormのコードモジュールに記述して下さい

Option Explicit

Private rngScope As Range

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

  Dim lngFound As Long
  Dim lngOver As Long
  
  TextBox2.Text = ""
  
  With TextBox1
    If .Text <> "" Then
      '探索範囲から、値を探索
      lngFound = ColumnSearh(CLng(.Text), rngScope, lngOver)
      '探索が失敗した場合(探索値其の物が無い場合)
      If lngFound = 0 Then
        '探索値を超える最小値のある列が範囲内の場合
        If lngOver <= rngScope.Columns.Count Then
          TextBox2.Text = rngScope(, lngOver).Value
        '範囲から外れる場合
        Else
          Beep
          MsgBox "参照値の範囲を超えています"
          Cancel = True
        End If
      '探索が成功した場合
      Else
        TextBox2.Text = rngScope(, lngFound).Value
      End If
    End If
  End With
  
End Sub

Private Sub UserForm_Initialize()

  Dim lngColumns As Long
  
  '探索範囲の先頭セル位置を指定
  With ActiveSheet.Cells(1, "A")
    '列数を取得
    lngColumns = .Offset(, 256 - .Column).End(xlToLeft).Column - .Column + 1
    If lngColumns <= 1 And .Value = "" Then
      MsgBox "参照データが有りません"
      Exit Sub
    End If
    '探索範囲を変数に代入
    Set rngScope = .Resize(, lngColumns)
  End With
  
End Sub

Private Sub UserForm_Terminate()

  Set rngScope = Nothing
  
End Sub

Private Function ColumnSearh(vntKey As Variant, _
            rngScope As Range, _
            Optional lngOver As Long) As Long

  Dim vntFound As Variant
  
  'Matchによる二分探索
  vntFound = Application.Match(vntKey, rngScope, 1)
  'もし、エラーで無いなら
  If Not IsError(vntFound) Then
    'もし、Key値と探索位置の値が等しいなら
    If vntKey = rngScope(, vntFound).Value Then
      '戻り値として、列位置を代入
      ColumnSearh = vntFound
    End If
    'Key値を超える最小値のある列
    lngOver = vntFound + 1
  Else
    lngOver = 1
  End If
  
End Function

0 hits

【28222】match関数について KIKAKU 05/8/31(水) 15:44 質問
【28226】Re:match関数について ichinose 05/8/31(水) 16:42 発言
【28227】Re:match関数について KIKAKU 05/8/31(水) 17:33 お礼
【28233】Re:match関数について Hirofumi 05/8/31(水) 21:12 回答
【28238】Re:match関数について KIKAKU 05/9/1(木) 0:03 質問
【28242】Re:match関数について ichinose 05/9/1(木) 7:20 発言
【28273】Re:match関数について Hirofumi 05/9/1(木) 20:46 回答
【28275】Re:match関数について Hirofumi 05/9/1(木) 21:46 発言
【28305】Re:match関数について KIKAKU 05/9/2(金) 12:53 質問
【28311】Re:match関数について ichinose 05/9/2(金) 13:21 発言
【28340】Re:match関数について KIKAKU 05/9/2(金) 18:50 質問
【28354】Re:match関数について ichinose 05/9/3(土) 8:53 発言
【28365】Re:match関数について KIKAKU 05/9/3(土) 22:06 お礼
【28349】Re:match関数について Hirofumi 05/9/2(金) 22:21 回答

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