Excel VBA質問箱 IV

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

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


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

【7005】リストボックスへのアイテム追加 Cager 03/8/19(火) 23:44 質問
【7010】Re:リストボックスへのアイテム追加 INA 03/8/20(水) 9:08 質問
【7021】Re:リストボックスへのアイテム追加 Cager 03/8/20(水) 14:59 質問
【7034】Re:リストボックスへのアイテム追加 Hirofumi 03/8/20(水) 21:36 回答
【7052】Re:リストボックスへのアイテム追加 Cager 03/8/21(木) 11:03 お礼
【7075】書き忘れた事が有りました Hirofumi 03/8/21(木) 20:27 発言

【7005】リストボックスへのアイテム追加
質問  Cager  - 03/8/19(火) 23:44 -

引用なし
パスワード
   はじめまして。Cagerと申します。
様々な本やHELPと格闘しながら初めてのVBA作成を試みておりますが
リストボックスへのアイテム追加でつまづいてしまいました。。

現在UserForm上に
ListBox1     :選択肢羅列用(ExcelのSheetから項目を拾ってきます)
ListBox2     :選択済項目表示用(別のSheetへ書き出します)
コマンドボタン1 :選択済
          ListBox1→2へアイテム追加
         (ListBox1からはRemoveItemにて項目が削除されます)
コマンドボタン2 :選択解除
          ListBox2→1へアイテム追加
         (1同様ListBox2からはRemoveItemにて項目が削除されます)
オプションボタン1:選択肢(本社所属社員名)
オプションボタン2:選択肢(支店所属社員名)

以上のような構成で使用していますが、
1.オプションボタン1を選択した状態で社員AとBを選択。
2.オプションボタン2を選択し社員XとYを選択。
3.再度オプションボタン1を選択すると選択肢に社員AとBが表示される。。。

3.で既にリストボックス2に存在するアイテムは
リストボックス1へ表示されないようにしたいと思っているのですが
上手くできません。

因みにリストボックスへのアイテム追加は
以下の記述にて行っております。

====================================================
Private Sub OptionButton1_Click()
Dim i
For i = 3 To 200
With Sheets("Sheet1")
If .Cells(i,1) = "本社" Then
ListBox1.List = .Cells(i,2)
End If
End With
Next i
End Sub
====================================================

初歩的な質問かもしれませんが
良いアドバイスがありますしたら是非宜しくお願い致します。

【7010】Re:リストボックスへのアイテム追加
質問  INA  - 03/8/20(水) 9:08 -

引用なし
パスワード
   >1.オプションボタン1を選択した状態で社員AとBを選択。
何が変化するのか、よく分からないのですが?
社員AとBとは何ですか?

>2.オプションボタン2を選択し社員XとYを選択。
社員XとYとは何ですか?

【7021】Re:リストボックスへのアイテム追加
質問  Cager  - 03/8/20(水) 14:59 -

引用なし
パスワード
   ▼INA さん:
>>1.オプションボタン1を選択した状態で社員AとBを選択。
>何が変化するのか、よく分からないのですが?
>社員AとBとは何ですか?
>
>>2.オプションボタン2を選択し社員XとYを選択。
>社員XとYとは何ですか?


INAさん、極力簡潔に書きたいと思って書いたのですが
結局説明が足りない書き方で申し訳ありませんでした。
以下実際私が使用しているコードとあわせて記入させていただきます。
---------------------------------------------------------------------
○オプションボタン1を選択すると
Private Sub OptionButton1_Click()
  ListBox1.Clear
  Sheets("DB").Activate
Dim i
  For i = 3 To 300
  If Sheets("DB").Cells(i, 20).Value = "本社" Then
  ListBox1.AddItem Sheets("DB").Cells(i, 3).Value
  ListBox1.Selected(0) = True
  End If
Next i
End Sub
以上のコードでワークシート("DB")からリストボックス1へ
アイテム(社員の名前)を表示させています。
---------------------------------------------------------------------
○オプションボタン2を選択すると
If Sheets("DB").Cells(i, 20).Value = "支店" Then
以外は上と同じコードでListBox1への表示対象を変えています。
---------------------------------------------------------------------
○ListBox1のアイテムを選択した状態でコマンドボタン1をクリックすると
Private Sub CommandButton1_Click()
Dim i
For i = 0 To ListBox1.ListCount - 1
  If ListBox1.Selected(i) = True Then
    ListBox2.AddItem ListBox1.List(i)
    ListBox1.RemoveItem (ListBox1.ListIndex)
  End If
  Next i
End Sub
以上のコードからListBox1からListBox2へ項目が移るようにしています。
---------------------------------------------------------------------

1.オプションボタン1からListBox1へ表示される本社社員(「A」「B」「C」「D」)のうち
「A」と「B」をListBox2へ表示させたあとにオプションボタン2を選択し、
ListBox1へ表示された支店社員(「W」「X」「Y」「Z」)のうち「X」「Y」をListBox2へ追加。
(この状態でListBoxへは「A」「B」「X」「Y」が表示されています)

2.1.の作業後に再度オプションボタン1を選択すると、
(先のコードでは当たり前でしょうが)本社社員「A」「B」も
ListBox1へ表示されてしまいます。
(コマンドボタン1で再度ListBox2へ追加出来てしまいます)

最終的にListBox2にある項目(社員名)のみ別シートへ出力したいのですが、
ListBox2に既に表示されている名前はListBox1へは表示されないように
したいのです。

以上で私のやりたいことが理解していただけるかどうか不安ですが、
良いお知恵がありましたら宜しくお願い致します。

【7034】Re:リストボックスへのアイテム追加
回答  Hirofumi E-MAIL  - 03/8/20(水) 21:36 -

引用なし
パスワード
   こんな動作をさせたいのかな?
ただ、ListBox1、2共に2列で2列目を非表示にしていますので
後で、氏名を参照する場合は、ListBox2.List(Index,0)を参照すれば出来ます
またBoundColumnは変更していませんので、.Valueで得られる値は通常どおりです

Option Explicit

Private vntIndex() As Variant
Private strSection As String

Private Sub UserForm_Initialize()

  Dim i As Long
  Dim vntData As Variant
  Dim vntSection As Variant
  
  With Worksheets("DB")
    vntData = Range(.Cells(3, 3), _
            .Cells(65536, 3).End(xlUp)).Value
    vntSection = Range(.Cells(3, 20), _
            .Cells(UBound(vntData, 1) + 2, 20)).Value
  End With
  ReDim vntIndex(UBound(vntData, 1) - 1, 2)
  For i = 0 To UBound(vntIndex, 1)
    vntIndex(i, 0) = True
    vntIndex(i, 1) = vntData(i + 1, 1)
    vntIndex(i, 2) = vntSection(i + 1, 1)
  Next i
  With ListBox1
    .ColumnCount = 2
    .ColumnWidths = CStr(.Width - 4) & ";0"
  End With
  With ListBox2
    .ColumnCount = 2
    .ColumnWidths = CStr(.Width - 4) & ";0"
  End With
  OptionButton1 = True
  
End Sub

Private Sub CommandButton1_Click()

  Dim i As Long
  
  With ListBox1
    For i = 0 To .ListCount - 1
      If .Selected(i) = True Then
        ListBox2.AddItem .List(i, 0)
        ListBox2.List(ListBox2.ListCount - 1, 1) _
                          = .List(i, 1)
        vntIndex(.List(i, 1), 0) = False
      End If
    Next i
    For i = .ListCount - 1 To 0 Step -1
      If .Selected(i) = True Then
        .RemoveItem (i)
      End If
    Next i
  End With

End Sub

Private Sub CommandButton2_Click()

  Dim i As Long
  
  With ListBox2
    For i = 0 To .ListCount - 1
      If .Selected(i) = True Then
        vntIndex(.List(i, 1), 0) = True
      End If
    Next i
    MakeList
    For i = .ListCount - 1 To 0 Step -1
      If .Selected(i) = True Then
        .RemoveItem (i)
      End If
    Next i
  End With

End Sub

Private Sub OptionButton1_Click()

  strSection = "本社"
  MakeList
  
End Sub

Private Sub OptionButton2_Click()

  strSection = "支店"
  MakeList

End Sub

Private Sub MakeList()

  Dim i As Long
  
  With ListBox1
    .Clear
    For i = 0 To UBound(vntIndex, 1)
      If vntIndex(i, 2) = strSection _
              And vntIndex(i, 0) Then
        .AddItem vntIndex(i, 1)
        .List(.ListCount - 1, 1) = i
      End If
    Next i
  End With
  
End Sub

【7052】Re:リストボックスへのアイテム追加
お礼  Cager  - 03/8/21(木) 11:03 -

引用なし
パスワード
   ▼Hirofumi さん:
>こんな動作をさせたいのかな?
>ただ、ListBox1、2共に2列で2列目を非表示にしていますので
>後で、氏名を参照する場合は、ListBox2.List(Index,0)を参照すれば出来ます
>またBoundColumnは変更していませんので、.Valueで得られる値は通常どおりです

Cagerです。早速のレスポンス有難うございます。
コードを転記してみましたところ正に私の望む結果が得られました。

正直、(今の私には)コードの中身が理解出来ない部分も沢山あるのですが
今後勉強して理解出来るように頑張ります!

本当に有難うございました。

【7075】書き忘れた事が有りました
発言  Hirofumi E-MAIL  - 03/8/21(木) 20:27 -

引用なし
パスワード
   もう見ていないかな?
ListBox2に取り出された人員をSheet1にList出力する方法を書き忘れましたので
Upして置きます

UserFormにCommandButton3、CommandButton4を追加して下さい
尚、出力はDBシートのA列〜T列迄をコピーしてくるものとします
また、各ListBoxの非表示にした、2列目の値と、vntIndex配列の0列の値は、
DBシートの3行目を基準とした、行のOffset値と同じです
詰まり、この値に3を加算すると、DBシートの行位置が出ます

Private Sub CommandButton3_Click()

'  ListBox2の順番で出力

  Dim i As Long
  Dim lngWriteRow As Long
  Dim lngCopyRow As Long
  Dim wksResult As Worksheet
  
  '結果出力シートを設定
  Set wksResult = Worksheets("Sheet1")
  '結果出力シートをクリア
  wksResult.Cells.ClearContents
  '出力行を指定
  lngWriteRow = 1
  With Worksheets("DB").Cells(3, 1)
    'DBシートの列見出しをコピー
    Range(.Offset(-1, 0), _
        .Offset(-1, 19)).Copy _
          Destination:=wksResult.Cells(lngWriteRow, 1)
    '出力行を更新
    lngWriteRow = lngWriteRow + 1
    'ListBox2の先頭から読み出し
    For i = 0 To ListBox2.ListCount - 1
      'DBの行位置のOffset値を取得
      'List(i, 1)の値はDBシートの3行目を基準としたOffset値
      lngCopyRow = ListBox2.List(i, 1)
      'DBシートから指定行をコピーして、結果シートにペースト
      Range(.Offset(lngCopyRow, 0), _
          .Offset(lngCopyRow, 19)).Copy _
            Destination:=wksResult.Cells(lngWriteRow, 1)
      '出力行を更新
      lngWriteRow = lngWriteRow + 1
    Next i
  End With
  
  Set wksResult = Nothing
  
  'UserFormを閉じる
  Unload Me
  
End Sub

Private Sub CommandButton4_Click()

'  DBシートの順番で出力

  Dim i As Long
  Dim lngWriteRow As Long
  Dim wksResult As Worksheet
  
  '結果出力シートを設定
  Set wksResult = Worksheets("Sheet1")
  '結果出力シートをクリア
  wksResult.Cells.ClearContents
  '出力行を指定
  lngWriteRow = 1
  With Worksheets("DB").Cells(3, 1)
    'DBシートの列見出しをコピー
    Range(.Offset(-1, 0), _
        .Offset(-1, 19)).Copy _
          Destination:=wksResult.Cells(lngWriteRow, 1)
    '出力行を更新
    lngWriteRow = lngWriteRow + 1
    'vntIndex配列の先頭より読み出し
    For i = 0 To UBound(vntIndex, 1)
      'vntIndex(i, 0)がFalseの場合、ListBox2にListされている
      If vntIndex(i, 0) = False Then
        'iはDBシートの3行目を基準としたOffset値と同じ
        'DBシートから指定行をコピーして、結果シートにペースト
        Range(.Offset(i, 0), _
          .Offset(i, 19)).Copy _
            Destination:=wksResult.Cells(lngWriteRow, 1)
        '出力行を更新
        lngWriteRow = lngWriteRow + 1
      End If
    Next i
  End With
  
  Set wksResult = Nothing
  
  'UserFormを閉じる
  Unload Me
  
End Sub

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