Excel VBA質問箱 IV

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

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


17823 / 76732 ←次へ | 前へ→

【64357】Re:どなたか助けてください。
回答  Hirofumi  - 10/1/31(日) 13:56 -

引用なし
パスワード
   こんなのでは?

UserFormのコントロールは以下の様にします
Frame1:OptionButton1〜4が入っています
ComboBox1
TextBox1〜5
CommandButon1

Option Explicit

Private rngPrint As Range '基準セル位置
Private rngRec() As Range '基準セル位置
Private rngList As Range 'ComboBoxのList用シートの基準セル位置

Private Sub UserForm_Initialize()

  Dim i As Long
  Dim vntName As Variant
  
  '印刷用シートの基準位置を設定
  Set rngPrint = Worksheets("印刷用").Range("A1")
  
  '各記録用シートの名前を列挙
  vntName = Array("記録用1", "記録用2", "記録用3", "記録用4")
  ReDim rngRec(UBound(vntName))
  For i = 0 To UBound(vntName)
    '各記録用シートの基準位置を設定
    Set rngRec(i) = Worksheets(vntName(i)).Range("A1")
    'OptionButtonのTagに番号を設定
    Controls("OptionButton" & i + 1).Tag = i
  Next i
  
  'ComboBoxのList用シートの基準セル位置を設定
  Set rngList = Worksheets("リストデータ用").Range("A1")
  
  OptionButton1.Value = 1
  
End Sub

Private Sub UserForm_Terminate()

  Dim i As Long
  
  Set rngPrint = Nothing
  
  For i = 0 To UBound(rngRec)
    Set rngRec(i) = Nothing
  Next i
  
  Set rngList = Nothing

End Sub

Private Sub CommandButton1_Click()

  Dim i As Long
  
  'ComboBox1に入力が無ければ
'  If ComboBox1.ListCount = -1 Then
  If ComboBox1.Text = "" Then
    Exit Sub
  End If
  
  With rngPrint
    '印刷用シートA列1行に値を転記
    .Value = ComboBox1.Text
    'TextBoxの値を転記
    .Offset(, 1).Value = TextBox1.Text
    .Offset(, 2).Value = TextBox2.Text
    .Offset(, 3).Value = TextBox3.Text
    .Offset(, 4).Value = TextBox4.Text
    .Offset(, 5).Value = TextBox5.Text
  End With
  
  With rngRec(Me.Tag)
    Do Until IsEmpty(.Offset(i).Value)
      i = i + 1
    Loop
    '記録用シートのA列の空白セルに転送
    '印刷用シートA列1行に値を転記
    .Offset(i).Value = ComboBox1.Text
    'TextBoxの値を転記
    .Offset(i, 1).Value = TextBox1.Text
    .Offset(i, 2).Value = TextBox2.Text
    .Offset(i, 3).Value = TextBox3.Text
    .Offset(i, 4).Value = TextBox4.Text
    .Offset(i, 5).Value = TextBox5.Text
  End With
  
  TextBox1.Text = ""
  TextBox2.Text = ""
  TextBox3.Text = ""
  TextBox4.Text = ""
  TextBox5.Text = ""

End Sub

Private Sub OptionButton1_Click()

  GetComboList OptionButton1.Tag
  
End Sub

Private Sub OptionButton2_Click()

  GetComboList OptionButton2.Tag

End Sub

Private Sub OptionButton3_Click()

  GetComboList OptionButton3.Tag

End Sub

Private Sub OptionButton4_Click()

  GetComboList OptionButton4.Tag

End Sub

Private Sub GetComboList(vntNumb As Variant)

  Dim lngRow As Long
  
  Me.Tag = vntNumb
  
  With rngList.Offset(, vntNumb)
    '行数の取得
    lngRow = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
    If lngRow >= 1 And .Value <> "" Then
      ComboBox1.Text = ""
      ComboBox1.Clear
      ComboBox1.List = .Resize(lngRow).Value
    End If
  End With
  
End Sub

0 hits

【64343】どなたか助けてください。 どんちゃん 10/1/31(日) 9:18 発言
【64345】Re:どなたか助けてください。 Hirofumi 10/1/31(日) 9:47 発言
【64346】Re:どなたか助けてください。 どんちゃん 10/1/31(日) 10:01 発言
【64347】Re:どなたか助けてください。 Hirofumi 10/1/31(日) 10:57 発言
【64348】Re:どなたか助けてください。 どんちゃん 10/1/31(日) 11:09 発言
【64349】Re:どなたか助けてください。 こぎつね 10/1/31(日) 11:20 発言
【64350】Re:どなたか助けてください。 どんちゃん 10/1/31(日) 11:34 回答
【64351】Re:どなたか助けてください。 こぎつね 10/1/31(日) 12:32 発言
【64357】Re:どなたか助けてください。 Hirofumi 10/1/31(日) 13:56 回答
【64353】Re:どなたか助けてください。 かみちゃん 10/1/31(日) 13:17 発言
【64354】Re:どなたか助けてください。 どんちゃん 10/1/31(日) 13:23 発言
【64355】Re:どなたか助けてください。 かみちゃん 10/1/31(日) 13:30 発言
【64360】Re:どなたか助けてください。 どんちゃん 10/1/31(日) 14:55 発言
【64362】Re:どなたか助けてください。 かみちゃん 10/1/31(日) 15:42 発言
【64365】Re:どなたか助けてください。 どんちゃん 10/1/31(日) 16:54 発言
【64356】Re:どなたか助けてください。 ponpon 10/1/31(日) 13:37 発言
【64363】Re:どなたか助けてください。 どんちゃん 10/1/31(日) 16:12 発言
【64366】Re:どなたか助けてください。 かみちゃん 10/1/31(日) 16:55 発言

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