Excel VBA質問箱 IV

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

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


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

【42649】Noを手がかりにユーザフォームに表示させたい Tomi 06/9/17(日) 19:44 質問[未読]
【42650】Re:Noを手がかりにユーザフォームに表示... ponpon 06/9/17(日) 20:39 発言[未読]
【42651】Re:Noを手がかりにユーザフォームに表示さ... Hirofumi 06/9/17(日) 21:00 回答[未読]
【42653】Re:Noを手がかりにユーザフォームに表示さ... Hirofumi 06/9/18(月) 14:24 回答[未読]
【42655】Re:Noを手がかりにユーザフォームに表示さ... Tomi 06/9/18(月) 14:34 お礼[未読]
【42663】Re:Noを手がかりにユーザフォームに表示さ... Jigsaw 06/9/18(月) 19:43 回答[未読]
【42664】Re:Noを手がかりにユーザフォームに表示さ... Jigsaw 06/9/18(月) 19:47 回答[未読]
【42666】Re:Noを手がかりにユーザフォームに表示さ... Tomi 06/9/18(月) 20:55 お礼[未読]

【42649】Noを手がかりにユーザフォームに表示させ...
質問  Tomi  - 06/9/17(日) 19:44 -

引用なし
パスワード
   ユーザフォームのコマンドボタンを二つ(△と▽)作成し
表のNoを手がかりに、No1から順に7まで(▽)選択またその逆の(△)で
移動選択したく思います。
(また、スクロールバーでも同じような動作をさせることが出来るでしょか)
Noは一部欠番もあります。

現在作業スペースを使って次のようなコードを書いていますが・・・
Private Sub CommandButton1_Click()
  If Cells(1, 10).Value > 2 Then
    Cells(1, 10).Value = Cells(1, 10).Value - 1
  End If   
End Sub
その作業スペースを使わない方法を検討しています。

移動選択と共に、項目1がテキストボックスにでるようにもしたいのです。
どなたか作り方を教えてください。

N0    項目1    項目2
1    A    AAA
2    B    BBB
4    D    DDD
5    E    EEE
7    H    HHH

【42650】Re:Noを手がかりにユーザフォームに表示...
発言  ponpon  - 06/9/17(日) 20:39 -

引用なし
パスワード
   コマンドボタンより、スピンボタンの方がよいのでは?

    label1    label2     label3
    ___  ▲   ___    ___
   |___|▼  |___|  |___|
   Textbox1 ↑   Textbox2   Textbox3
       スピンボタン 

ユーザーフォームにこのように配置して
データがSheet1にあるとして
こんな感じではないかと思うのですが・・・

Private Sub UserForm_Initialize()
  Dim i As Integer
  With Me
    With .SpinButton1
      .Min = 2
      .Max = Sheets("Sheet1").Range("A65536").End(xlUp).Row
      .Value = 2
    End With
    For i = 1 To 3
     .Controls("TextBox" & i).Value = ""
    Next
    .Label1.Caption = "NO"
    .Label2.Caption = "項目1"
    .Label3.Caption = "項目2"
   End With
End Sub

Private Sub SpinButton1_Change()
  Dim i As Integer
  
  With Me
    For i = 1 To 3
     .Controls("TextBox" & i).Value = Sheets("Sheet1").Cells(.SpinButton1.Value, i)
    Next
  End With
End Sub

【42651】Re:Noを手がかりにユーザフォームに表示...
回答  Hirofumi  - 06/9/17(日) 21:00 -

引用なし
パスワード
   >選択という意味が善く解らないのですが?
レコードの上下移動と言う意味でしょうか?
レコードの項目は違いますが、過去に作ったUserFormのコードが有りますので、
参考に成るかどうか見て下さい

尚、Noは昇順に並んでいることが条件です
探索の開始は、TextBox1のExitイベントで番号を探します
また、TextBox1に無い番号を入れた場合、新規入力に成り
例えば、10番、12番が存在する時、11番を指定すると10番、12番の間に行が挿入され11番が書きこまれます

UserFormの配置は、
TextBox1〜4
CommandButton1 入力(UserFormからセルに書き込み)
CommandButton2 削除(現在表示されている番号の行を削除)
CommandButton3 ↑移動
CommandButton4 ↓移動
を想定しています

以下のコードをUserFormモジュールに記入

Option Explicit

'Listの列数
Private Const clngColumns As Long = 7
'探索Keyの有る列位置(基準位置からの列Offset)
Private Const clngKeys As Long = 0

'Listの先頭、最左の列見出しのセル位置
Private rngList As Range
'Listの行数
Private lngRows As Long
'操作対象行位置
Private lngCurrent As Long
'存在Flag(0以外は、該当Keyが存在する)
Private lngFound As Long

Private Sub UserForm_Initialize()
  
  'Listの先頭セル位置を基準として設定(最左の列見出しのセル位置)
  Set rngList = ActiveSheet.Cells(1, "A")
  With rngList
    'Listのデータ行数取得
    lngRows = .Offset(Rows.Count - .Row, clngKeys).End(xlUp).Row - .Row
    If lngRows < 0 Then
      lngRows = 0
    End If
  End With
    
  'スクロールバーの初期化
  With ScrollBar1
    .Max = lngRows
    .Min = 1
    .TabStop = False
    .LargeChange = 10
  End With
  
End Sub

Private Sub UserForm_Activate()

  'コントロールの初期化
  ControlsInitialize
  'データ範囲にデータが有るなら
  If lngRows > 0 Then
    '操作行を先頭行に
    lngCurrent = 1
    '存在行を先頭行に
    lngFound = 1
    'スクロールバーを先頭行に設定
    ScrollBar1.Value = lngCurrent
    RowUpDown
  Else
    '操作行を未定に
    lngCurrent = 0
    '存在行を未定に
    lngFound = 0
  End If
  
End Sub

Private Sub UserForm_Terminate()

  Set rngList = Nothing
  
End Sub

Private Sub CommandButton1_Click()
  
'  データを転記

  Dim i As Long

  '操作行が未定なら
  If lngCurrent = 0 Then
    Exit Sub
  End If
  
  '探索Keyが存在するなら
  If lngFound > 0 Then
    'データの上書き
    SetData lngCurrent
  Else
    '作成行がデータ範囲内なら
    If lngCurrent <= lngRows Then
      rngList.Offset(lngCurrent).EntireRow.Insert
    End If
    'List行数をインクリメント
    lngRows = lngRows + 1
    'スクロールバーの範囲を更新
    ScrollBar1.Max = lngRows
    '挿入位置にデータの転記
    SetData lngCurrent
  End If
  
  '存在行を操作行に
  lngFound = lngCurrent

End Sub

Private Sub CommandButton2_Click()

' 該当行を削除

  Dim i As Long
  
  If lngFound > 0 And lngCurrent > 0 Then
    Beep
    If MsgBox("Key " & TextBox1.Text & " のDataを削除します", _
        vbExclamation + vbOKCancel, "削除") = vbOK Then
      '操作行を削除
      rngList.Offset(lngCurrent).EntireRow.Delete
      'List行数をディクリメント
      lngRows = lngRows - 1
      'スクロールバーの範囲を更新
      ScrollBar1.Max = lngRows
      'データ行が有るなら
      If lngRows > 0 Then
        '次のデータを表示
        RowUpDown
        '存在行を操作行に
        lngFound = lngCurrent
      Else
        '操作行を未定に
        lngCurrent = 0
        '存在行を未定に
        lngFound = 0
        'コントロールの初期化
        ControlsInitialize
      End If
    End If
  End If
    
End Sub

Private Sub CommandButton3_Click()

'  行のDouwn

  lngCurrent = lngCurrent - 1
  RowUpDown
  
End Sub

Private Sub CommandButton4_Click()

'  行のUp

  lngCurrent = lngCurrent + 1
  RowUpDown
  
End Sub

Private Sub OptionButton1_Click()

  With OptionButton1
    .Parent.Tag = .Caption
  End With
    
End Sub

Private Sub OptionButton2_Click()

  With OptionButton2
    .Parent.Tag = .Caption
  End With
    
End Sub

Private Sub ScrollBar1_Change()

  lngCurrent = ScrollBar1.Value
  RowUpDown
  
End Sub

Private Sub TextBox1_Enter()

  'コントロールの初期化
  ControlsInitialize
  
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

  Dim lngOver As Long
  Dim vntKey As Variant
  
  With TextBox1
    If .Text <> "" Then
      '探索Keyを取得
      vntKey = .Text
      'Listにデータ行が有るなら
      If lngRows > 0 Then
        'Listから該当するKeyの行を探索(探索Keyが数値の場合)
        lngFound = RowSearch(CLng(vntKey), rngList.Offset(1, _
                  clngKeys).Resize(lngRows), lngOver)
        'Listから該当するKeyの行を探索(探索Keyが文字列の場合)
'        lngFound = RowSearch(vntKey, rngList.Offset(1, _
                  clngKeys).Resize(lngRows), lngOver)
      Else
        lngFound = 0
        lngOver = 1
      End If
      '探索Keyの該当行が有る場合
      If lngFound > 0 Then
        '操作行を存在行に
        lngCurrent = lngFound
        'コントロールに値読み込み
        GetData lngCurrent
      Else
        'コントロールの初期化
        ControlsInitialize
        TextBox1.Text = vntKey
        Beep
        If MsgBox("該当するレコードが有りませんので新規作成します", _
            vbExclamation + vbOKCancel, "新規入力") = vbOK Then
          '操作行を行挿入位置に設定
          lngCurrent = lngOver
          CommandButton1.Enabled = True
        Else
          '操作行を未定に
          lngCurrent = 0
          Cancel = True
        End If
      End If
    Else
      '操作行を未定に
      lngCurrent = 0
      '存在行を未定に
      lngFound = 0
    End If
  End With

End Sub

Private Sub ControlsInitialize()

'  各コントロールの初期化

  Dim i As Long
  
  CommandButton1.Enabled = False
  CommandButton2.Enabled = False
  
  For i = 1 To 5
    Me.Controls("TextBox" & i).Text = ""
  Next i
  OptionButton1.Value = True
  TextBox6.Text = ""
  
End Sub

Private Sub GetData(lngRow As Long)

'  1行分のListデータを各コントロールに代入

  Dim i As Long
  Dim vntData As Variant
  
  With rngList.Offset(lngRow)
    .Activate
    'データを1行分、配列に取得
    vntData = .Resize(, clngColumns).Value
  End With
  
  '配列のデータを各コントロールに代入
  For i = 1 To 5
    Controls("TextBox" & i).Text = vntData(1, i)
  Next i
  With Frame1
    For i = 0 To .Controls.Count - 1
      If .Controls(i).Caption = CStr(vntData(1, 6)) Then
        .Controls(i).Value = True
        Exit For
      End If
    Next i
    If i > .Controls.Count - 1 Then
      .Controls(0).Value = True
    End If
  End With
  TextBox6.Text = Format(vntData(1, 7), "ggge年m月d日")
  
  CommandButton1.Enabled = True
  CommandButton2.Enabled = True
  
  'スクロールバーの表示位置更新
  With ScrollBar1
    If .Value <> lngRow Then
      .Value = lngRow
    End If
  End With
  
End Sub

Private Sub SetData(lngRow As Long)

'  各コントロールデータを1行分のListに代入

  Dim i As Long
  Dim vntData As Variant
  
  '1行分の出力用配列を確保
  ReDim vntData(1 To 1, 1 To clngColumns)
  
  '各コントロールの値を配列に代入
  For i = 1 To 5
    vntData(1, i) = Controls("TextBox" & i).Text
  Next i
  vntData(1, 6) = Frame1.Tag
  vntData(1, 7) = TextBox6.Text

  With rngList.Offset(lngRow)
    .Activate
    '配列を出力
    .Resize(, clngColumns).Value = vntData
  End With
  
  'スクロールバーの表示位置更新
  With ScrollBar1
    If .Value <> lngRow Then
      .Value = lngRow
    End If
  End With
  
End Sub

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

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

Private Sub RowUpDown()

'  行のUP、Douwn

  'LIst範囲にデータが無い場合
  If lngRows < 1 Then
    lngCurrent = 0
    Exit Sub
  End If

  '操作行が、LIst範囲を超えるなら
  If lngCurrent > lngRows Then
    '操作行を最終行に
    lngCurrent = lngRows
  ElseIf lngCurrent < 1 Then
    '操作行を先頭行に
    lngCurrent = 1
  End If
  
  '存在行を操作行に
  lngFound = lngCurrent
  
  'コントロールに値読み込み
  GetData lngCurrent
  
  TextBox2.SetFocus
  
End Sub

尚、データは下記の物を想定しています
ID  氏名   郵便番号  住所            電話番号   性別  生年月日
1  山田 敬司 1120012  東京都文京区大塚X-XX-X    035978xxxx  男  昭和35年1月30日
2  木下 美絵 1790072  東京都練馬区光が丘X-X-X-XX  033976XXXX  女  昭和61年12月30日
4  篠ウ 望人 1920907  東京都八王子市長沼町XXX-XX  042636xxxx  男  昭和49年9月25日

【42653】Re:Noを手がかりにユーザフォームに表示...
回答  Hirofumi  - 06/9/18(月) 14:24 -

引用なし
パスワード
   あ!、コントロールが抜けていました
UserFormに以下を配置して下さい

UserFormの配置は、
TextBox1〜6
Frame1 中にOptionButton1、OptionButton2
CommandButton1 入力(UserFormからセルに書き込み)
CommandButton2 削除(現在表示されている番号の行を削除)
CommandButton3 ↑移動
CommandButton4 ↓移動
ScrollBar1  レコード移動

を想定しています

【42655】Re:Noを手がかりにユーザフォームに表示...
お礼  Tomi  - 06/9/18(月) 14:34 -

引用なし
パスワード
   ponponさん Hirofumiさん
こんにちは。お礼が遅くなりました。

早速丁寧なご解答ありがとうございました。
大変良く分かりました。このようなコードで表現することの素晴らしさを
理解しました。
コマンドボタンで、入力データをシートに転記するコードを書きました
A列はうまくいきますが、B,C列は一行下にデータが転記されます(AからCまで
一行でそろいません)。どこが問題なのでしょうか?
もしご覧になっておられましたら、よろしくお願いします。

Private Sub CommandButton1_Click()
Dim i As Integer
 For i = 0 To 2
  Range("A65536").End(xlUp).Offset(1, i) = UserForm1.Controls("TextBox" & i + 1).Value
 Next
End Sub


Hirofumiさん
非常に長いコードで私が理解できるまでに、時間がかかりそうです。
大切にコードを保存してじっくり勉強させていただきます。
ご指摘の通り、住所録のチェックと入力に活用する予定です。

本当にありがとうございました。
これからもよろしくご指導のほどお願いします。

【42663】Re:Noを手がかりにユーザフォームに表示...
回答  Jigsaw  - 06/9/18(月) 19:43 -

引用なし
パスワード
   ▼Tomi さん:
こんばんは。

変数「i」の値に注目すれば、おのずと答えが見つかりますね。(^^)

無理をなさらずに変数を一つ増やせばシンプルに解決しますよ。
実用的な例としては、↓のようになると思います。


Private Sub CommandButton1_Click()

  Dim i As Integer
  Dim j As Integer
  
  i = Range("A65536").End(xlUp).Row
  i = i + 1
  
  For j = 1 To 3
    Cells(i, j) = UserForm1.Controls("TextBox" & j)
  Next j

  For j = 1 To 3
    UserForm1.Controls("TextBox" & j) = ""
  Next j

End Sub

【42664】Re:Noを手がかりにユーザフォームに表示...
回答  Jigsaw  - 06/9/18(月) 19:47 -

引用なし
パスワード
   ▼Tomi さん:

お試しください。

CommandButton1 …△
CommandButton2 …▽
CommandButton3 …指定NO
TextBox1.Value …NO
TextBox2.Value …項目1
TextBox3.Value …項目2

UserForm1に、以上6つのパーツを貼り付ける


■標準モジュールには、

Sub 表示の表示()
  UserForm1.Show
End Sub


■「UserForm1」には、

'-------------------------------
Option Explicit 'グローバル変数の宣言
Dim 指定行 As Integer
Dim 指定NO As Integer

'-------------------------------

Private Sub UserForm_initialize() ''''''初期設定…先頭データの表示
  指定行 = 2
  Call 表示
End Sub

'-------------------------------

Private Sub CommandButton1_Click() ''''''△
  指定行 = 指定行 - 1
  Call 表示
End Sub

'-------------------------------

Private Sub CommandButton2_Click() ''''''▽
  指定行 = 指定行 + 1
  Call 表示
End Sub

'-------------------------------

Private Sub CommandButton3_Click() ''''''指定NO
  指定NO = TextBox1.Value
  On Error GoTo ES
  指定行 = Application.WorksheetFunction.Match(指定NO, Range("A1:A6"), 0)
  Call 表示
  Exit Sub
  
ES:
  MsgBox "該当NOなし"
  Exit Sub
  
End Sub

'-------------------------------

Private Sub 表示()

  With Worksheets("Sheet1")
    TextBox1.Value = .Cells(指定行, 1).Value 'NO
    TextBox2.Value = .Cells(指定行, 2).Value '項目1
    TextBox3.Value = .Cells(指定行, 3).Value '項目2
  End With
    
End Sub


        ┘┘┘┘┘┘┘┘┘┘┘┘┘

「TextBox1.Value」に指定NOを入力して、「CommandButton3」をクリックすると、ご希望の表示がされます。
(^^)

【42666】Re:Noを手がかりにユーザフォームに表示...
お礼  Tomi  - 06/9/18(月) 20:55 -

引用なし
パスワード
   ▼Jigsaw さん:

こんばんは。
Tomi です。

色々とご指定、ご指導ありがとうございます。
上手く動きました。欲が出てきて、もう少し・・・このような
ことも出来れば、ついつい質問をして恐縮しています。

素晴らしいコードを頂き、感謝します。
ありがとうございました。
これかもよろしくご指導ください。

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