Excel VBA質問箱 IV

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

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


9027 / 13646 ツリー ←次へ | 前へ→

【29677】リストボックスからリストボックスへリスト移動時 初心者 05/10/11(火) 17:29 質問[未読]
【29688】Re:リストボックスからリストボックスへ... hine 05/10/11(火) 20:15 発言[未読]
【29691】Re:リストボックスからリストボックスへリ... りん 05/10/11(火) 22:07 回答[未読]
【29703】Re:リストボックスからリストボックスへリ... 初心者 05/10/12(水) 9:08 質問[未読]
【29740】Re:リストボックスからリストボックスへリ... りん 05/10/12(水) 21:40 回答[未読]
【29763】Re:リストボックスからリストボックスへリ... 初心者 05/10/13(木) 10:25 質問[未読]
【29764】Re:リストボックスからリストボックスへリ... 初心者 05/10/13(木) 10:25 質問[未読]
【29704】Re:リストボックスからリストボックスへリ... 初心者 05/10/12(水) 9:13 質問[未読]
【29732】Re:リストボックスからリストボックスへリ... りん 05/10/12(水) 19:23 発言[未読]
【29760】Re:リストボックスからリストボックスへリ... 初心者 05/10/13(木) 9:35 発言[未読]

【29677】リストボックスからリストボックスへリス...
質問  初心者  - 05/10/11(火) 17:29 -

引用なし
パスワード
   以前はお世話になりました。
大変、勉強になっております。

またも、壁にぶつかってしまったために、
質問させてください。
ユーザーフォームにて
リストボックスを二つ、
コマンドボタンを一つ、
テキストボックスを一つ用意し、
1.リストボックスAのデータを複数シートへ用意する
2.リストボックスAのリストを選択すると、
  テキストボックスへ、値(数字)が表示される
3.リストボックスAにてリスト選択し、
  コマンドボタンでリストボックスBへリストをコピーする
4.リストボックスBのリストを選択した際、
  リストボックスAと同じ値(数字)が表示される
上記のような動作をさせたいのですが、
うまくいきません。
どうか、ご教授宜しくお願い致します。
Private Sub ListBox2_Click()
  TextBox1.Text = ListBox2.ListIndex
End Sub
など、簡単なことから、少しずつ試したのですが、
自分の知識ではどうにもなりませんでした。
どうか、宜しくお願いします。

【29688】Re:リストボックスからリストボックスへ...
発言  hine  - 05/10/11(火) 20:15 -

引用なし
パスワード
   初心者 さん
こんばんは

>Private Sub ListBox2_Click()
>  TextBox1.Text = ListBox2.ListIndex
>End Sub


TextBox1.Value = ListBox2.Value

ではいかがですか?

【29691】Re:リストボックスからリストボックスへ...
回答  りん E-MAIL  - 05/10/11(火) 22:07 -

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

>ユーザーフォームにて
>リストボックスを二つ、
>コマンドボタンを一つ、
>テキストボックスを一つ用意し、

これらがそのままの名前で準備されているとして。

Private Sub CommandButton1_Click()
  On Error Resume Next
  ListBox2.Text = ListBox1.Text
  On Error GoTo 0
  '
  If ListBox2.ListCount = 0 Or ListBox1.Text <> ListBox2.Text Then
    ListBox2.AddItem ListBox1.Text 'なければアイテム追加
  End If
End Sub

Private Sub ListBox1_Change()
  If ListBox1.ListIndex >= 0 Then TextBox1.Text = ListBox1.Text
End Sub

Private Sub ListBox2_Change()
  If ListBox2.ListIndex >= 0 Then ListBox1.Text = ListBox2.Text
End Sub

Private Sub UserForm_Activate()
  ListBox1.Clear '念のためクリア
  ListBox2.Clear '念のためクリア
  TextBox1.Text = ""
  'シート1というワークシートのデータを読み込む
  ListBox1.RowSource = "シート1!A1:A10"
End Sub

こんな感じです。
リストボックスの値が数値の時は、Valueでの比較がうまくいかなかったのでTextで比較しました。

【29703】Re:リストボックスからリストボックスへ...
質問  初心者  - 05/10/12(水) 9:08 -

引用なし
パスワード
   hineさん・りんさん
とても丁寧な回答ありがとうございます。
ものすごく参考になります。
リストボックスA・リストボックスBをchangeにし、
お教えいただいたとおりにやった結果、
うまくいきました。
ありがとうございます。
図々しいかと思ったのですが、
もう一つ質問させてください。

データ自体に修正を加えて、
シート内のデータに、項目・数値を用意し、
リストボックスAのリスト(項目)を選択した際、
テキストボックスへリストボックスAの数値が表示され、
コマンドボタンを押すことで、
リストボックスBへリストボックスAの項目がコピーされ、
リストボックスBのリスト(項目)を選択した際、
リストボックスAと同じ数値がテキストボックスへ表示されるようにしたいのですが、
あれから、しばらく悩んだのですが、
結局できませんでした。

再三に渡る質問で大変申し訳ないのですが、
よろしかったら、ご教授お願い致します。

【29704】Re:リストボックスからリストボックスへ...
質問  初心者  - 05/10/12(水) 9:13 -

引用なし
パスワード
   追記・・・

リストボックスAにてリスト(項目)選択時、
テキストボックスへ数値を表示させるには、

Private Sub ListBox4_Click()
  TextBox1.Text = Range("sheet1!C3").Offset(ListBox1.ListIndex).Text
End Sub

といった形で表示させています。
sheet1のB3:B10に項目データを用意し、
sheet1のC3:C10に数値データを用意しました。

度々の質問申し訳ありません。
どうかよろしくお願いします。

【29732】Re:リストボックスからリストボックスへ...
発言  りん E-MAIL  - 05/10/12(水) 19:23 -

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

>リストボックスAにてリスト(項目)選択時、
>テキストボックスへ数値を表示させるには、
>Private Sub ListBox4_Click()
>  TextBox1.Text = Range("sheet1!C3").Offset(ListBox1.ListIndex).Text
>End Sub
このコードを見る限り、参考にしているとは思えないのですが。

【29740】Re:リストボックスからリストボックスへ...
回答  りん E-MAIL  - 05/10/12(水) 21:40 -

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

>シート内のデータに、項目・数値を用意し、
>リストボックスAのリスト(項目)を選択した際、
>テキストボックスへリストボックスAの数値が表示され、
>コマンドボタンを押すことで、
>リストボックスBへリストボックスAの項目がコピーされ、
>リストボックスBのリスト(項目)を選択した際、
>リストボックスAと同じ数値がテキストボックスへ表示されるようにしたいのですが、
>あれから、しばらく悩んだのですが、
>結局できませんでした。

フォームのコントロール類は、前回と同じ条件です。

Option Explicit
Private Sub CommandButton1_Click()
  Dim Li1 As Integer, Lc2 As Integer
  'ListBox2に転送時にお互いのListIndex値を覚えておく
  With ListBox1
    Li1 = .ListIndex
    If .List(Li1, 2) < 0 Then
      ListBox2.AddItem .List(Li1, 1) '2列目(C列)のデータを追加
      Lc2 = ListBox2.ListCount '追加された行
      ListBox2.List(Lc2 - 1, 1) = Li1
      .List(Li1, 2) = Lc2
    End If
  End With
End Sub
'
Private Sub ListBox1_Change()
  With ListBox1
    If .ListIndex >= 0 Then TextBox1.Text = .Text
  End With
End Sub
'
Private Sub ListBox2_Change()
  Dim Li2 As Integer
  With ListBox2
    Li2 = Val(.List(.ListIndex, 1))
  End With
  'エラー回避のため分岐
  If Li2 >= 0 Then ListBox1.ListIndex = Li2
  'TextBox1.Text = ListBox2.Text
End Sub

Private Sub UserForm_Activate()
  Dim Ldat(3 To 10, 1 To 3), RR As Integer, CC As Integer
  TextBox1.Text = ""
  With ListBox1
    .Clear '念のためクリア
    .ColumnCount = 3 '隠れ2列あり
    .ColumnWidths = .Width & ";0;0"
    .TextColumn = 2
  End With
  With ListBox2
    .Clear '念のためクリア
    .ColumnCount = 2
    .ColumnWidths = .Width & ";0" '隠れ1列あり
  End With
  'リストを読み込む Worksheets("Sheet1").Range("B3:C10")
  For RR = 3 To 10
    For CC = 1 To 3
      If CC = 3 Then
        Ldat(RR, CC) = -1 'リストインデックス取得用(作業列)
      Else
        Ldat(RR, CC) = Worksheets("Sheet1").Cells(RR, CC + 1)
      End If
     Next
  Next
  'セット
  ListBox1.List = Ldat()
  Erase Ldat
End Sub

こんな感じです。

【29760】Re:リストボックスからリストボックスへ...
発言  初心者  - 05/10/13(木) 9:35 -

引用なし
パスワード
   ▼りん さん:
>このコードを見る限り、参考にしているとは思えないのですが。

大変すいませんでした。
とても参考にしているのですが、
自分の作っているマクロを全文出すのが恥ずかしかったため、
抜粋して載せたことで、
誤解を招く結果になってしまい、
申し訳ありませんでした。

【29763】Re:リストボックスからリストボックスへ...
質問  初心者  - 05/10/13(木) 10:25 -

引用なし
パスワード
   りんさん、おはようございます。
追記にて、大変失礼なことをしてしまい、
申し訳ありませんでした。
もし、愛想が尽きていないようでしたら、
ご教授、宜しくお願い致します。

作りたいマクロ。
マクドナルドの注文表みたいな感じです。
オプションボタンにチェックを入れることで、
リストボックスにて、ボタンに応じたリストが表示され、
複数セットしたリストボックスのリストを選択している状態で、
コマンドボタンを押すと、
テキストボックスへ合計を表示させる
ことが目的です。

用意したもの
リストボックス×5
テキストボックス×2
オプションボタン×16
コマンドボタン×6
イメージ×1

準備
データは、ワークシートを7シート使い、
1シート目は、コマンドボタンを設置し、
ユーザーフォームを表示させ、
選択したリストを表示させるために使います。
残り6シートは、
すべて項目+数字で構成されています。

不完全・長いマクロですが、
よろしくお願いします。

Private Sub CommandButton2_Click()
  Dim i As Long
  Dim u As Long
  Dim a As Long
  Dim b As Long
  Dim total As Long
  Dim c As Integer
  
  total = 0
  If ListBox1.Selected(i) = True Then
    i = Range("サンドイッチ!C3").Offset(ListBox1.ListIndex).Text
  Else
  i = 0
  End If
  If ListBox2.Selected(u) = True Then
    If サイドS = True Then
      u = Range("サイドメニュー!C4").Offset(ListBox2.ListIndex).Text
    ElseIf サイドM = True Then
      u = Range("サイドメニュー!D4").Offset(ListBox2.ListIndex).Text
    ElseIf サイドL = True Then
      u = Range("サイドメニュー!E4").Offset(ListBox2.ListIndex).Text
    End If
  Else
    u = 0
  End If
  If ListBox3.Selected(a) = True Then
  If ドリンクCOLD = True Then
    If ドリンクS = True Then
      a = Range("コールドドリンク!C4:C10").Offset(ListBox3.ListIndex).Text
    ElseIf ドリンクM = True Then
      a = Range("コールドドリンク!D4").Offset(ListBox3.ListIndex).Text
    ElseIf ドリンクL = True Then
      a = Range("コールドドリンク!E4").Offset(ListBox3.ListIndex).Text
    End If
  ElseIf ドリンクHOT = True Then
    a = Range("ホットドリンク!C4").Offset(ListBox3.ListIndex).Text
    If ドリンクM = True Then
      a = Range("ホットドリンク!D8").Offset(ListBox3.ListIndex).Text
    End If
  End If
  Else
    a = 0
  End If
  If ListBox5.List(c) = True Then
  If ListBox4.ListIndex = -1 Then Exit Sub
    For i = 0 To ListBox4.ListCount - 1
      If ListBox4.Selected(c) Then
      ListBox5.AddItem ListBox4.List(c)
      ListBox4.Selected(c) = False
    End If
  Next i
  Else
  c = 0
  End If
    total = total + i + u + a + b
    TextBox2.Text = total
  total = 0
  TextBox2.SetFocus
End Sub

Private Sub CommandButton4_Click()
  Dim a As Integer
  Dim b As Integer
  Dim c As Integer
  Dim e As Integer
  
  TextBox2 = ""
  
  If ListBox1.Selected(a) Then
    ListBox1.Selected(a) = False
  End If
  If ListBox2.Selected(b) Then
    ListBox2.Selected(b) = False
  End If
  If ListBox3.Selected(c) Then
    ListBox3.Selected(c) = False
  End If
  If ListBox5.Selected(e) Then
    ListBox5.Selected(e) = False
  End If
End Sub

Private Sub ListBox1_Change()
  Dim no As Variant
  Dim pname As String
  no = ListBox1.ListIndex
  
  TextBox1.Text = Range("サンドイッチ!C3").Offset(ListBox1.ListIndex).Text
  pname = "C:\Documents and Settings\kasahara\My Documents\笠原\excel\マック\menu" & Format(no, "00") & ".jpg"
  If Dir(pname) <> "" Then
    Image1.Picture = LoadPicture(pname)
  Else
    Image1.Picture = LoadPicture(ThisWorkbook.Path & "\menu_03.gif")
  End If
End Sub

Private Sub ListBox2_Click()
  If サイドS = True Then
    TextBox1.Text = Range("サイドメニュー!C4").Offset(ListBox2.ListIndex).Text
  ElseIf サイドM = True Then
    TextBox1.Text = Range("サイドメニュー!D4").Offset(ListBox2.ListIndex).Text
  ElseIf サイドL = True Then
    TextBox1.Text = Range("サイドメニュー!E4").Offset(ListBox2.ListIndex).Text
  End If
End Sub

Private Sub ListBox3_Click()
  If ドリンクCOLD = True Then
    If ドリンクS = True Then
      TextBox1.Text = Range("コールドドリンク!C4").Offset(ListBox3.ListIndex).Text
    ElseIf ドリンクM = True Then
      TextBox1.Text = Range("コールドドリンク!D4").Offset(ListBox3.ListIndex).Text
    ElseIf ドリンクL = True Then
      TextBox1.Text = Range("コールドドリンク!E4").Offset(ListBox3.ListIndex).Text
    End If
  ElseIf ドリンクHOT = True Then
    TextBox1.Text = Range("ホットドリンク!C4").Offset(ListBox3.ListIndex).Text
    If ドリンクM = True Then
      TextBox1.Text = Range("ホットドリンク!D8").Offset(ListBox3.ListIndex).Text
    End If
  End If
End Sub

Private Sub ListBox4_Change()
  With ListBox4
    If .ListIndex >= 0 Then TextBox1.Text = ListBox5.Text
      If サイドCOLD = True Then
        If サイドサイズS = True Then
          TextBox1.Text = Range("追加決定!C22").Offset(ListBox4.ListIndex).Text
        ElseIf サイドサイズM = True Then
          TextBox1.Text = Range("追加決定!E22").Offset(ListBox4.ListIndex).Text
        ElseIf サイドサイズL = True Then
          TextBox1.Text = Range("追加決定!G22").Offset(ListBox4.ListIndex).Text
        End If
      ElseIf サイドHOT = True Then
        TextBox1.Text = Range("追加決定!C17").Offset(ListBox4.ListIndex).Text
        If サイドサイズM = True Then
          TextBox1.Text = Range("追加決定!E17").Offset(ListBox4.ListIndex).Text
        End If
      ElseIf サイドサンド = True Then
        TextBox1.Text = Range("追加決定!C3").Offset(ListBox4.ListIndex).Text
      ElseIf サイドサイド = True Then
        TextBox1.Text = Range("追加決定!I3").Offset(ListBox4.ListIndex).Text
        If サイドサイズS = True Then
          TextBox1.Text = Range("追加決定!C14").Offset(ListBox4.ListIndex).Text
        ElseIf サイドサイズM = True Then
          TextBox1.Text = Range("追加決定!E14").Offset(ListBox4.ListIndex).Text
        ElseIf サイドサイズL = True Then
          TextBox1.Text = Range("追加決定!G14").Offset(ListBox4.ListIndex).Text
        End If
      ElseIf サイド100 = True Then
        TextBox1.Text = Range("100円!C3").Offset(ListBox4.ListIndex).Text
      End If
  End With
End Sub

Private Sub ListBox5_Change()
  Dim Li2 As Integer
  With ListBox5
    Li2 = Val(.List(.ListIndex, 1))
  End With
  'エラー回避のため分岐
  If Li2 >= 0 Then ListBox4.ListIndex = Li2
  'TextBox1.Text = ListBox2.Text
End Sub

【29764】Re:リストボックスからリストボックスへ...
質問  初心者  - 05/10/13(木) 10:25 -

引用なし
パスワード
   Private Sub UserForm_Initialize()
  ListBox1.RowSource = "サンドイッチ!B3:B13"
  ListBox2.RowSource = "サイドメニュー!B4:B7"
  ListBox3.RowSource = "コールドドリンク!B4:B18"
  サイドS = True
  ドリンクS = True
  ドリンクCOLD = True
  Image1.Picture = LoadPicture(ThisWorkbook.Path & "\default.gif")
  With ListBox4
    .Clear '念のためクリア
    .ColumnCount = 3 '隠れ2列あり
    .ColumnWidths = .Width & ";0;0"
    .TextColumn = 2
  End With
  With ListBox5
    .Clear '念のためクリア
    .ColumnCount = 2
    .ColumnWidths = .Width & ";0" '隠れ1列あり
  End With
End Sub

Private Sub サイド100_Click()
  ListBox4.RowSource = "100円!B3:B20"
End Sub

Private Sub サイドCOLD_Click()
  If サイドサイズS = True Then
    ListBox4.RowSource = "追加決定!B22:B36"
  ElseIf サイドサイズM = True Then
    ListBox4.RowSource = "追加決定!D22:D32"
  ElseIf サイドサイズL = True Then
    ListBox4.RowSource = "追加決定!F22:F29"
  ElseIf サイドサイズS = False Then
    ListBox4.RowSource = "追加決定!H14:H47"
  End If
End Sub

Private Sub サイドHOT_Click()
  If サイドサイズS = True Then
    ListBox4.RowSource = "追加決定!B17:B21"
  ElseIf サイドサイズM = True Then
    ListBox4.RowSource = "追加決定!D17"
  ElseIf サイドサイズL = True Then
    ListBox4.RowSource = ""
  ElseIf サイドサイズS = False Then
    ListBox4.RowSource = "追加決定!H8:H13"
  End If
End Sub

Private Sub サイドL_Click()
  ListBox2.RowSource = "サイドメニュー!B4"
End Sub

Private Sub サイドM_Click()
  ListBox2.RowSource = "サイドメニュー!B4"
End Sub

Private Sub サイドS_Click()
  ListBox2.RowSource = "サイドメニュー!B4:B7"
End Sub

Private Sub サイドサイズL_Click()
  If サイドCOLD Then
    ListBox4.RowSource = "追加決定!F22:F29"
  ElseIf サイドHOT = True Then
    ListBox4.RowSource = ""
  ElseIf サイドサイド = True Then
    If サイドサイズS = True Then
      ListBox4.RowSource = "追加決定!B14:B16"
    ElseIf サイドサイズM = True Then
      ListBox4.RowSource = "追加決定!D14"
    ElseIf サイドサイズL = True Then
      ListBox4.RowSource = "追加決定!F14"
    End If
  End If
End Sub

Private Sub サイドサイズM_Click()
  If サイドCOLD Then
    ListBox4.RowSource = "追加決定!D22:D32"
  ElseIf サイドHOT = True Then
    ListBox4.RowSource = "追加決定!D17"
  ElseIf サイドサイド = True Then
    If サイドサイズS = True Then
      ListBox4.RowSource = "追加決定!B14:B16"
    ElseIf サイドサイズM = True Then
      ListBox4.RowSource = "追加決定!D14"
    ElseIf サイドサイズL = True Then
      ListBox4.RowSource = "追加決定!F14"
    End If
  End If
End Sub

Private Sub サイドサイズS_Click()
  If サイドCOLD Then
    ListBox4.RowSource = "追加決定!B22:B36"
  ElseIf サイドHOT = True Then
    ListBox4.RowSource = "追加決定!B17:B21"
  ElseIf サイドサイド = True Then
    If サイドサイズS = True Then
      ListBox4.RowSource = "追加決定!B14:B16"
    ElseIf サイドサイズM = True Then
      ListBox4.RowSource = "追加決定!D14"
    ElseIf サイドサイズL = True Then
      ListBox4.RowSource = "追加決定!F14"
    End If
  End If
End Sub

Private Sub サイドサイド_Click()
  ListBox4.RowSource = "追加決定!H3:H7"
End Sub

Private Sub サイドサンド_Click()
  ListBox4.RowSource = "追加決定!B3:B13"
End Sub

Private Sub ドリンクCOLD_Click()
  If ドリンクS = True Then
    ListBox3.RowSource = "コールドドリンク!B4:B18"
  ElseIf ドリンクM = True Then
    ListBox3.RowSource = "コールドドリンク!B4:B14"
  ElseIf ドリンクL = True Then
    ListBox3.RowSource = "コールドドリンク!B4:B11"
  End If
End Sub

Private Sub ドリンクHOT_Click()
  If ドリンクS = True Then
    ListBox3.RowSource = "ホットドリンク!B4:B8"
  ElseIf ドリンクM = True Then
    ListBox3.RowSource = "ホットドリンク!B8"
  ElseIf ドリンクL = True Then
    ListBox3.RowSource = ""
  End If
End Sub

Private Sub ドリンクL_Click()
  If ドリンクCOLD = True Then
    ListBox3.RowSource = "コールドドリンク!B4:B11"
  ElseIf ドリンクHOT = True Then
    ListBox3.RowSource = ""
  End If
End Sub

Private Sub ドリンクM_Click()
  If ドリンクCOLD Then
    ListBox3.RowSource = "コールドドリンク!B4:B14"
  ElseIf ドリンクHOT = True Then
    ListBox3.RowSource = "ホットドリンク!B8"
  End If
End Sub

Private Sub ドリンクS_Click()
  If ドリンクCOLD Then
    ListBox3.RowSource = "コールドドリンク!B4:B18"
  ElseIf ドリンクHOT = True Then
    ListBox3.RowSource = "ホットドリンク!B4:B8"
  End If
End Sub

Private Sub 追加決定_Click()
  Dim Li1 As Integer, Lc2 As Integer
  'ListBox2に転送時にお互いのListIndex値を覚えておく
  With ListBox4
    Li1 = .ListIndex
    If .List(Li1, 2) < 0 Then
      ListBox5.AddItem .List(Li1, 1) '2列目(C列)のデータを追加
      Lc2 = ListBox5.ListCount '追加された行
      ListBox5.List(Lc2 - 1, 1) = Li1
      .List(Li1, 2) = Lc2
    End If
  End With
End Sub

Private Sub 追加消去_Click()
  Dim i As Integer
  
  For i = ListBox5.ListCount - 1 To 0 Step -1
    If ListBox5.Selected(i) Then
      ListBox5.RemoveItem (i)
      Exit For
    End If
  Next i
End Sub

こんな感じで作っています。
色々なサイトを回りながら、少しずつ手を加えていってる状態ですので、
かなり不完全ですが、
よろしかったら、ご教授お願い致します。

長々と申し訳ありません。

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