Excel VBA質問箱 IV

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

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


9026 / 13644 ツリー ←次へ | 前へ→

【29736】フレームについてお聞きしたいのですが masa 05/10/12(水) 20:46 質問[未読]
【29737】Re:フレームのOptionButtonの値によりマク... かみちゃん 05/10/12(水) 20:57 回答[未読]
【29738】Re:フレームのOptionButtonの値によりマク... masa 05/10/12(水) 21:11 お礼[未読]
【29742】Re:フレームについてお聞きしたいのですが Hirofumi 05/10/12(水) 21:56 回答[未読]
【29756】Re:フレームについてお聞きしたいのですが masa 05/10/13(木) 7:28 お礼[未読]
【29744】Re:フレームについてお聞きしたいのですが りん 05/10/12(水) 22:02 発言[未読]

【29736】フレームについてお聞きしたいのですが
質問  masa  - 05/10/12(水) 20:46 -

引用なし
パスワード
   エクセルでsheet1,sheet2で
sheet1には
  a   b   c
1 31101 あああ
2 31102 いいい
3 31103 ううう
4 31104 えええ
5 31105 おおお
6
7

sheet2には

  a   b      c   d      e   f 
1 101 かかか   101 さささ   101 たたた
2 102 ききき   102 ししし   102 ちちち
3 103 くくく   103 すすす   103 つつつ
4 104 けけけ   104 せせせ   104 ててて
5
6

UserForm1においてテキストボックスを6個、フレーム内にオプションボタンを3つ作りました。
テキストボックス1に入植した数値をsheet1より探しテキストボックス2に表示する。
フレームないのボタンをボタン1、ボタン2、ボタン3としたとき、ボタン1を選択したときにはテキストボックス3より数値を入力し、ボタン1を選択していればa列から検索、ボタン2を選択していればc列から検索、ボタン3を選択したときにはe列から検索しそれをテキストボックス4に返したいと思います。
Private Sub textbox1_Change()
  
  Worksheets("sheet1").Select  'シートを選択する
  
  Dim oriVal As String
  Dim tmpVal As String
  Dim i As Integer
 
  oriVal = TextBox1.Text
 
  For i = 1 To Range("A65536").End(xlUp).Row
    tmpVal = Range("A" & i).Value
    If oriVal = tmpVal Then
      TextBox2.Value = Range("A" & i).Offset(0, 1).Value
    End If
  Next i
  
  Worksheets("sheet2").Select   'シートを選択する
   
  If OptionButton1 = 1 Then Goto koku
  If OptionButton2 = 1 Then Goto kou
  If OptionButton3 = 1 Then Goto siri
End sub
-----------------------------------------
Sub koku()
  Dim koku1 As String
  Dim koku2 As String
  Dim k As Integer
 
  koku1 = TextBox3.Text
 
  For k = 1 To Range("A65536").End(xlUp).Row
    koku2 = Range("A" & k).Value
    If koku1 = koku2 Then
      TextBox4.Value = Range("A" & k).Offset(0, 1).Value
    End If
  Next k
End Sub
-----------------------------------------------------------------
Sub kou()
  Dim kou1 As String
  Dim kou2 As String
  Dim u As Integer
 
  koku1 = TextBox3.Text
 
  For u = 1 To Range("C65536").End(xlUp).Row
    kou2 = Range("C" & u).Value
    If kou1 = kou2 Then
      TextBox4.Value = Range("C" & u).Offset(0, 1).Value
    End If
  Next u
End Sub
--------------------------------------------------------------
Sub siri()
  Dim siri1 As String
  Dim siri2 As String
  Dim s As Integer
 
  siri1 = TextBox3.Text
 
  For s = 1 To Range("E65536").End(xlUp).Row
    koku2 = Range("E" & s).Value
    If siri1 = siri2 Then
      TextBox4.Value = Range("E" & s).Offset(0, 1).Value
    End If
  Next s
End Sub
のように作ってみたもののOptionButtonにおいての操作が良く分かりません。また
If OptionButton1 = 1 Then Goto koku のところでエラーが起きます。どうすれば良いのか教えてもらいたいのですが。

【29737】Re:フレームのOptionButtonの値によりマ...
回答  かみちゃん  - 05/10/12(水) 20:57 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>If OptionButton1 = 1 Then Goto koku のところでエラーが起きます。

どういうエラーになるのですか?
もしかして、「行ラベルが定義されていません。」というエラーではないでしょうか?

Private Sub textbox1_Change()

End Sub

の中にkoku: という記述がないと動きません。
しかし、
OptionButton1 = 1
のときに、

Sub koku()

End Sub
を実行したいということならば、
If OptionButton1 = 1 Then Call koku
でできると思います。

【29738】Re:フレームのOptionButtonの値によりマ...
お礼  masa  - 05/10/12(水) 21:11 -

引用なし
パスワード
   ありがとうございます。
エラーメッセージは確かに「行ラベルが定義されていません。」というエラーです。
Private Sub textbox1_Change()

End Sub
kokuをどう定義すれば良いのですか?
Dim koku As と言うのはおかしいかなと思っているのですが・・・
私はVBAを初めて間もないので良く理解できません。よろしければ教えてもらえませんか?

あとIf OptionButton1 = 1 Then Call koku でも良いのかと思ってやってはみたのですがうまく表示できないんです。

【29742】Re:フレームについてお聞きしたいのですが
回答  Hirofumi  - 05/10/12(水) 21:56 -

引用なし
パスワード
   全くコードが違ってしまいますが?
こんなのでも善いかも?

Sheet1、Sheet2共に、Keyが昇順に整列されているなら

      '探索値が数値の場合
      lngFound = RowSearchBin(Val(.Text), rngBox1, 1)

      '探索値が数値の場合
      lngFound = RowSearchBin(Val(.Text), rngBox3(Val(Frame1.Tag)), 1)

「RowSearchBin」の最終引数を1にした方が探索が速くなります

尚、Match関数を使用していますので、表の探される値が文字列の時と数値の時で
コードが少し違いますので気を就けて下さい

Option Explicit

Private rngBox1 As Range
Private rngBox3(1 To 3) As Range

Private Sub OptionButton1_Click()

  Frame1.Tag = 1
  
  If Not Box3Update Then
    TextBox3.SetFocus
  End If
    
End Sub

Private Sub OptionButton2_Click()

  Frame1.Tag = 2
  
  If Not Box3Update Then
    TextBox3.SetFocus
  End If
      
End Sub

Private Sub OptionButton3_Click()

  Frame1.Tag = 3
  
  If Not Box3Update Then
    TextBox3.SetFocus
  End If
    
End Sub

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

  Dim lngFound As Long
  
  With TextBox1
    If .Text <> "" Then
      '探索値が文字列の場合
'      lngFound = RowSearchBin(.Text, rngBox1, 0)
      '探索値が数値の場合
      lngFound = RowSearchBin(Val(.Text), rngBox1, 0)
      If lngFound > 0 Then
        TextBox2.Text = rngBox1(lngFound, 2)
      Else
        Beep
        MsgBox "該当データが有りません"
        Cancel = True
      End If
    End If
  End With
  
End Sub

Private Sub TextBox3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

  If Not Box3Update Then
    Cancel = True
  End If
  
End Sub

Private Sub UserForm_Initialize()

  Dim i As Long
  Dim lngRows As Long
  
  OptionButton1.Value = True
  Frame1.Tag = 1
  
  '"Sheet1"のKey列を取得
  With Worksheets("Sheet1").Cells(1, "A")
    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
    Set rngBox1 = .Resize(lngRows)
  End With
  
  '"Sheet2"のKey列を取得
  For i = 1 To 3
    With Worksheets("Sheet2").Cells(1, (i - 1) * 2 + 1)
      lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
      Set rngBox3(i) = .Resize(lngRows)
    End With
  Next i
  
End Sub

Private Sub UserForm_Terminate()

  Dim i As Long
  
  '"Sheet1"のKey列を取得
  Set rngBox1 = Nothing
  
  '"Sheet2"のKey列を取得
  For i = 1 To 3
    Set rngBox3(i) = Nothing
  Next i

End Sub

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

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

Private Function Box3Update() As Boolean

  Dim lngFound As Long
  
  Box3Update = True
  With TextBox3
    If .Text <> "" Then
      '探索値が文字列の場合
'      lngFound = RowSearchBin(.Text, rngBox3(Val(Frame1.Tag)), 0)
      '探索値が数値の場合
      lngFound = RowSearchBin(Val(.Text), rngBox3(Val(Frame1.Tag)), 0)
      If lngFound > 0 Then
        TextBox4.Text = rngBox3(Val(Frame1.Tag))(lngFound, 2)
      Else
        Box3Update = False
        Beep
        MsgBox "該当データが有りません"
        TextBox4.Text = ""
      End If
    End If
  End With

End Function

【29744】Re:フレームについてお聞きしたいのですが
発言  りん E-MAIL  - 05/10/12(水) 22:02 -

引用なし
パスワード
   masa さん、こんばんわ。

ほかの部分は見ていませんが、オプションボタンの分岐だけ。

>Private Sub textbox1_Change()
>  
>  Worksheets("sheet1").Select  'シートを選択する
>  
>  Dim oriVal As String
>  Dim tmpVal As String
>  Dim i As Integer
> 
>  oriVal = TextBox1.Text
> 
>  For i = 1 To Range("A65536").End(xlUp).Row
>    tmpVal = Range("A" & i).Value
>    If oriVal = tmpVal Then
>      TextBox2.Value = Range("A" & i).Offset(0, 1).Value
>    End If
>  Next i
>  
>  Worksheets("sheet2").Select   'シートを選択する
>   
  If OptionButton1.Value = True Then koku
  If OptionButton2.Value = True Then kou
  If OptionButton3.Value = True Then siri
>End sub
>-----------------------------------------
>Sub koku()

>End Sub
>-----------------------------------------------------------------
>Sub kou()

>End Sub
>--------------------------------------------------------------
>Sub siri()

>End Sub
これでいかがですか?

【29756】Re:フレームについてお聞きしたいのですが
お礼  masa  - 05/10/13(木) 7:28 -

引用なし
パスワード
   皆様ありがとうございます。参考にさせていただきます。

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