Excel VBA質問箱 IV

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

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


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

【2574】コンボボックスで選択、そしてまた次のコンボボックスで選択 EBA 03/1/6(月) 11:07 質問
【2576】Re:コンボボックスで選択、そしてまた次のコ... ポンタ 03/1/6(月) 16:53 回答
【2659】Re:コンボボックスで選択、そしてまた次のコ... EBA 03/1/9(木) 17:31 お礼
【2577】Re:コンボボックスで選択、そしてまた次のコ... ichinose 03/1/6(月) 16:55 回答
【2596】Re:コンボボックスで選択、そしてまた次のコ... EBA 03/1/7(火) 13:16 お礼
【2604】Re:コンボボックスで選択、そしてまた次のコ... ichinose 03/1/7(火) 18:41 発言
【2614】Re:コンボボックスで選択、そしてまた次のコ... EBA 03/1/8(水) 10:39 お礼
【9653】Re:コンボボックスで選択、そしてまた次のコ... ぴ〜ちゃん 03/12/12(金) 1:39 質問
【9697】Re:コンボボックスで選択、そしてまた次のコ... ichinose 03/12/13(土) 2:48 回答
【9698】Re:コンボボックスで選択、そしてまた次のコ... ichinose 03/12/13(土) 9:52 発言
【9701】Re:コンボボックスで選択、そしてまた次のコ... ぴ〜ちゃん 03/12/14(日) 0:40 質問
【9703】Re:コンボボックスで選択、そしてまた次のコ... ぴ〜ちゃん 03/12/14(日) 9:07 お礼
【18724】Re:コンボボックスで選択、そしてまた次... ぴ〜こ 04/10/7(木) 15:23 質問[未読]
【18734】Re:コンボボックスで選択、そしてまた次... ichinose 04/10/7(木) 20:12 発言[未読]
【18735】Re:コンボボックスで選択、そしてまた次... ぴ〜こ 04/10/7(木) 20:53 質問[未読]
【18736】Re:コンボボックスで選択、そしてまた次... ichinose 04/10/7(木) 21:27 発言[未読]
【18752】Re:コンボボックスで選択、そしてまた次... ぴ〜こ 04/10/8(金) 20:55 お礼[未読]

【2574】コンボボックスで選択、そしてまた次のコ...
質問  EBA  - 03/1/6(月) 11:07 -

引用なし
パスワード
   またまたお世話になります。
Excel VBA初心者です。
早速質問なのですが、シート1に下のようなリストがあるとします。

   A       B
1  東京都  渋谷区
2  東京都  新宿区
3  東京都  港区
4  茨城県  水戸市 
5  茨城県  つくば市
6  茨城県  ひたちなか市      
.   .    .
.   .    .
.   .    .

ユーザーフォームを作り、そこにコンボボックス1、
コンボボックス2を作ります。
コンボボックス1で都道府県名を選択し、
コンボボックス2で、1で選択した都道府県の「区市郡」
を選択できるようにするにはどうしたらよいのでしょう。
どなたかご教授お願いいたします。

【2576】Re:コンボボックスで選択、そしてまた次の...
回答  ポンタ  - 03/1/6(月) 16:53 -

引用なし
パスワード
   対象のフォームモジュールに貼り付けてお試しください。

Sheet1.Columns("A")やMyRange.Offset(0, 1).Valueは
適当に書き換えてください。

Private Sub ComboBox1_Change()
  Dim MyRange As Range
  Dim FirstAddress As String
  ComboBox2.Clear
  Set MyRange = Sheet1.Columns("A").Find(ComboBox1.Value, Range("A65536"))
  If Not MyRange Is Nothing Then
    FirstAddress = MyRange.Address
    Do
      ComboBox2.AddItem (MyRange.Offset(0, 1).Value)
      Set MyRange = Sheet1.Columns("A").FindNext(MyRange)
    Loop While Not MyRange Is Nothing And MyRange.Address <> FirstAddress
  End If
End Sub

【2577】Re:コンボボックスで選択、そしてまた次の...
回答  ichinose  - 03/1/6(月) 16:55 -

引用なし
パスワード
   ▼EBA さん:
こんにちは。
>またまたお世話になります。
>Excel VBA初心者です。
>早速質問なのですが、シート1に下のようなリストがあるとします。
>
>   A       B
>1  東京都  渋谷区
>2  東京都  新宿区
>3  東京都  港区
>4  茨城県  水戸市 
>5  茨城県  つくば市
>6  茨城県  ひたちなか市      
>.   .    .
>.   .    .
>.   .    .
>
>ユーザーフォームを作り、そこにコンボボックス1、
>コンボボックス2を作ります。
>コンボボックス1で都道府県名を選択し、
>コンボボックス2で、1で選択した都道府県の「区市郡」
>を選択できるようにするにはどうしたらよいのでしょう。
>どなたかご教授お願いいたします。

A列が全て空白だった場合のエラー処理をしていませんが、
A列の重複なしのデータを取り出すのにC列をワークで使いました。
他の列が都合がよければ変更してください。
当該フォームモジュールに・・・
'===============================================================
Sub set_combo_item(cmb As MSForms.ComboBox, func_str As String)
'input: cmb データをセットするコンボボックス
'input: func_str データ抽出のための関数式
  Dim rng As Range
  Dim rng2 As Range
  Dim rng3 As Range
  With ThisWorkbook.Worksheets(1)
   Set rng = .Range("a1", .Range("a65536").End(xlUp))
   End With
  rng.Offset(0, 2).Formula = func_str
  rng.Offset(0, 2) = rng.Offset(0, 2).Value
  Set rng2 = rng.Offset(0, 2).SpecialCells(xlCellTypeConstants)
  cmb.Clear
  For Each rng3 In rng2
   cmb.AddItem rng3.Value
   Next
  cmb.ListIndex = 0
  rng2.Value = ""
  Set rng = Nothing
  Set rng2 = Nothing
  Set rng3 = Nothing
End Sub
'==============================
Private Sub ComboBox1_Change()
  Dim func_str As String
  func_str = "=if(a1=""" & ComboBox1.Text & """,b1,"""")"
  Call set_combo_item(ComboBox2, func_str)
End Sub
'==========================================================
Private Sub UserForm_Initialize()
  Dim func_str As String
  func_str = "=if(countif($a$1:a1,a1)>1,"""",a1)"
  Call set_combo_item(ComboBox1, func_str)
  func_str = "=if(a1=""" & ComboBox1.Text & """,b1,"""")"
  Call set_combo_item(ComboBox2, func_str)
End Sub

A列の重複なしデータの抽出は、他にも方法がありそうですよ。

【2596】Re:コンボボックスで選択、そしてまた次の...
お礼  EBA  - 03/1/7(火) 13:16 -

引用なし
パスワード
   ▼ichinose さん:
お返事が大変遅くなりまして申し訳ありません。
ありがとうございました。できました。
できたのですが、私、大変未熟者なので、コードの意味がいまひとつ解らないのです。
申し訳ありませんが、詳しく解説していただけると嬉しいのですが。
宜しかったらお願いいたします。

【2604】Re:コンボボックスで選択、そしてまた次の...
発言  ichinose  - 03/1/7(火) 18:41 -

引用なし
パスワード
   ▼EBA さん:
こんばんは。
>申し訳ありませんが、詳しく解説していただけると嬉しいのですが。
>宜しかったらお願いいたします。
サブプロシジャーの中ですよね?
'===============================================================
Sub set_combo_item(cmb As MSForms.ComboBox, func_str As String)
'input: cmb データをセットするコンボボックス
'input: func_str データ抽出のための関数式
'output:cmbのlistメンバー
  Dim rng As Range
  Dim rng2 As Range
  Dim rng3 As Range
  With ThisWorkbook.Worksheets(1)
   Set rng = .Range("a1", .Range("a65536").End(xlUp))
   End With
  '↑ここで、A列の都道府県名が入力されているセル範囲を取得しています。
  'A列が全て未入力の場合のチェックを本来は入れなければなりませんね

  rng.Offset(0, 2).Formula = func_str
  '↑ワーク列と決めたC列に数式を入力します。
  rng.Offset(0, 2) = rng.Offset(0, 2).Value
  '↑Specialcellsメソッドを使いたいため、数式の結果のみに変換しています
  Set rng2 = rng.Offset(0, 2).SpecialCells(xlCellTypeConstants)
  '↑値が入っているセルのみをrng2に取得します。ここも本来は、要エラー処理
  cmb.Clear
  For Each rng3 In rng2
   cmb.AddItem rng3.Value
   Next
  '↑パラメータで指定されたコンボボックスのメンバとして、セット
  cmb.ListIndex = 0
  '↑最初のメンバを表示するようにしています。
  rng2.Value = ""
  'ワークで使用したC列をクリア
  Set rng = Nothing
  Set rng2 = Nothing
  Set rng3 = Nothing
End Sub
一応、上記のようにコメントを付けましたが・・・。

【2614】Re:コンボボックスで選択、そしてまた次の...
お礼  EBA  - 03/1/8(水) 10:39 -

引用なし
パスワード
   ▼ichinose さん:
ありがとうございました。
大変参考になりました。
感謝、感謝でございます。m(__)m

【2659】Re:コンボボックスで選択、そしてまた次の...
お礼  EBA  - 03/1/9(木) 17:31 -

引用なし
パスワード
   ▼ポンタ さん:
御返事大変遅くなって申し訳ありません。
わかりました。できました。ありがとうございます!
いつも親切な御指導ありがとうございます。m(__)m

【9653】Re:コンボボックスで選択、そしてまた次の...
質問  ぴ〜ちゃん  - 03/12/12(金) 1:39 -

引用なし
パスワード
   こんにちは、
似たような質問ですので
返信にて質問させて下さい。
VBA初心者です。宜しくお願いします。

ユーザーフォームを作り、そこにコンボボックス1、
コンボボックス2を作ります。
シート1にコンボボックス1で都道府県名を選択し、
コンボボックス2で、1で選択した都道府県の「区市郡」
を選択できるようにします。
   A    B      C     D
1  東京都  渋谷区    10000人  14000人
2  東京都  新宿区    20000人  25000人
3  東京都  港区     50000人  55000人
4  茨城県  水戸市    20000人  20000人
5  茨城県  つくば市   25000人  25000人
6  茨城県  ひたちなか市 20000人  15000人      
.   .    .
.   .    .
.   .    .

シート2の任意のセルを選択するとフォームが表示されて
シート1で選択したコンボボックス1、コンボボックス2で
1で選択した都道府県の「区市郡」を
記入しコンボボックス2で選択した区市郡の人口 C、Dを
合わせて貼り付けたいのです。

シート2のA6を選択し、コンボボックス1−東京、
コンボボックス2−港区を選択した場合はこのようにしたいです。
   A    B      C     D
1 
2 
3 
4 
5 
6  東京都  港区     50000人  55000人 

宜しくお願いします。

>
>A列が全て空白だった場合のエラー処理をしていませんが、
>A列の重複なしのデータを取り出すのにC列をワークで使いました。
>他の列が都合がよければ変更してください。
>当該フォームモジュールに・・・
>'===============================================================
>Sub set_combo_item(cmb As MSForms.ComboBox, func_str As String)
>'input: cmb データをセットするコンボボックス
>'input: func_str データ抽出のための関数式
>  Dim rng As Range
>  Dim rng2 As Range
>  Dim rng3 As Range
>  With ThisWorkbook.Worksheets(1)
>   Set rng = .Range("a1", .Range("a65536").End(xlUp))
>   End With
>  rng.Offset(0, 2).Formula = func_str
>  rng.Offset(0, 2) = rng.Offset(0, 2).Value
>  Set rng2 = rng.Offset(0, 2).SpecialCells(xlCellTypeConstants)
>  cmb.Clear
>  For Each rng3 In rng2
>   cmb.AddItem rng3.Value
>   Next
>  cmb.ListIndex = 0
>  rng2.Value = ""
>  Set rng = Nothing
>  Set rng2 = Nothing
>  Set rng3 = Nothing
>End Sub
>'==============================
>Private Sub ComboBox1_Change()
>  Dim func_str As String
>  func_str = "=if(a1=""" & ComboBox1.Text & """,b1,"""")"
>  Call set_combo_item(ComboBox2, func_str)
>End Sub
>'==========================================================
>Private Sub UserForm_Initialize()
>  Dim func_str As String
>  func_str = "=if(countif($a$1:a1,a1)>1,"""",a1)"
>  Call set_combo_item(ComboBox1, func_str)
>  func_str = "=if(a1=""" & ComboBox1.Text & """,b1,"""")"
>  Call set_combo_item(ComboBox2, func_str)
>End Sub
>
>A列の重複なしデータの抽出は、他にも方法がありそうですよ。

【9697】Re:コンボボックスで選択、そしてまた次の...
回答  ichinose  - 03/12/13(土) 2:48 -

引用なし
パスワード
   ▼ぴ〜ちゃん さん:
こんばんは。
>ユーザーフォームを作り、そこにコンボボックス1、
>コンボボックス2を作ります。
>シート1にコンボボックス1で都道府県名を選択し、
>コンボボックス2で、1で選択した都道府県の「区市郡」
>を選択できるようにします。
>   A    B      C     D
>1  東京都  渋谷区    10000人  14000人
>2  東京都  新宿区    20000人  25000人
>3  東京都  港区     50000人  55000人
>4  茨城県  水戸市    20000人  20000人
>5  茨城県  つくば市   25000人  25000人
>6  茨城県  ひたちなか市 20000人  15000人      
>.   .    .
>.   .    .
>.   .    .
>
>シート2の任意のセルを選択するとフォームが表示されて
>シート1で選択したコンボボックス1、コンボボックス2で
>1で選択した都道府県の「区市郡」を
>記入しコンボボックス2で選択した区市郡の人口 C、Dを
>合わせて貼り付けたいのです。
>
>シート2のA6を選択し、コンボボックス1−東京、
>コンボボックス2−港区を選択した場合はこのようにしたいです。
>   A    B      C     D
>1 
>2 
>3 
>4 
>5 
>6  東京都  港区     50000人  55000人 
>
>宜しくお願いします。
せっかく、このツリーに投稿していただいたので
このツリーで記述したコードを少し変更したコードにしました。
では、ユーザーフォーム(Userform1)には、
Combobox1(都道府県選択用)とCombobox2(区市郡選択用)と
CommandButton1(シートに貼付実行ボタン)を配置してください。
シート名は、都道府県、区市郡及び、人数データの入っているマスターシートを
Sheet1(ぴ〜ちゃん さんがいあシート1)、
選択して貼り付けるシートのシート名は、任意でよいです(私は、Sheet2で確認しましたが・・・)
又、Sheet1のF列を作業列として使用した例です。作業列は、どこでもいいです。
尚、Sheet1にデータがない場合のエラー処理はしていませんので、ご了承ください。

当該フォームモジュールに
'=========================================================
Private Sub UserForm_Initialize()
  Dim func_str As String
  func_str = "=if(countif(sheet1!$a$1:a1,a1)>1,"""",a1)"
  Call set_combo_item(ComboBox1, func_str)
  func_str = "=if(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1,"""")"
  Call set_combo_item(ComboBox2, func_str)
End Sub
'=========================================================
Private Sub ComboBox1_Change()
  Dim func_str As String
  func_str = "=if(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1,"""")"
  Call set_combo_item(ComboBox2, func_str)
End Sub
'=========================================================
Private Sub CommandButton1_Click()
  Dim func_str As String
  Dim rng As Range
  func_str = "=if(and(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1=""" & ComboBox2.Text & """),row(),"""")"
  Set rng = get_func_rng(func_str)
  With ActiveCell
    Cells(.Row, 1).Value = ComboBox1.Text
    Cells(.Row, 2).Value = ComboBox2.Text
    For idx = 3 To 4
     Cells(.Row, idx).Value = Worksheets("sheet1").Cells(rng.Value, idx).Value
     Next
    End With
  rng.Value = ""
End Sub
'=========================================================
Function get_func_rng(func_str As String) As Range
'input: func_str データ抽出のための関数式
'out : get_func_rng 条件に合ったセル範囲
  Dim rng As Range
  With ThisWorkbook.Worksheets("sheet1")
   Set rng = .Range("a1", .Range("a65536").End(xlUp))
   End With
  rng.Offset(0, 5).Formula = func_str
  rng.Offset(0, 5) = rng.Offset(0, 5).Value
  Set get_func_rng = rng.Offset(0, 5).SpecialCells(xlCellTypeConstants)
'  ↑ここでF列を使っています、変更するなら5を別の数字に
End Function
'=========================================================
Sub set_combo_item(cmb As MSForms.ComboBox, func_str As String)
'input: cmb データをセットするコンボボックス
'input: func_str データ抽出のための関数式
  Dim rng As Range
  Dim rng2 As Range
  Set rng2 = get_func_rng(func_str)
  cmb.Clear
  For Each rng In rng2
   cmb.AddItem rng.Value
   Next
  cmb.ListIndex = 0
  rng2.Value = ""
  Set rng = Nothing
  Set rng2 = Nothing
End Sub


次にシート2のシートモジュールに
'===========================================================
Private Sub Worksheet_Activate()
  UserForm1.Show vbModeless
End Sub
'===========================================================
Private Sub Worksheet_Deactivate()
  Unload UserForm1
End Sub
'===========================================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  With UserForm1
    If .Visible = False Then .Show vbModeless
    End With
End Sub

尚、シート2では、コマンドボタンクリック時にどこのセルを選択しても
選択されたセルと同じ行のA列からデータが貼り付けられる仕様になっています。

【9698】Re:コンボボックスで選択、そしてまた次の...
発言  ichinose  - 03/12/13(土) 9:52 -

引用なし
パスワード
   ▼ぴ〜ちゃん さん:
おはようございます。
誤字とコード訂正です。

>当該フォームモジュールに
>'=========================================================
>Private Sub UserForm_Initialize()
>  Dim func_str As String
>  func_str = "=if(countif(sheet1!$a$1:a1,a1)>1,"""",a1)"
>  Call set_combo_item(ComboBox1, func_str)
>  func_str = "=if(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1,"""")"
>  Call set_combo_item(ComboBox2, func_str)
>End Sub
>'=========================================================
>Private Sub ComboBox1_Change()
>  Dim func_str As String
>  func_str = "=if(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1,"""")"
>  Call set_combo_item(ComboBox2, func_str)
>End Sub
>'=========================================================
>Private Sub CommandButton1_Click()
  Dim func_str As String
  Dim rng As Range
  Dim f_row As Long
  Dim w_row As Long
  func_str = "=if(and(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1=""" & ComboBox2.Text & """),row(),"""")"
  Set rng = get_func_rng(func_str)
  f_row = rng.Row
  w_row = ActiveCell.Row
  With Worksheets("sheet1")
     Range(Cells(w_row, 1), Cells(w_row, 4)).Value _
       = .Range(.Cells(f_row, 1), .Cells(f_row, 4)).Value
    End With
'一括で移行できるんだった
  rng.Value = ""
>End Sub
>'=========================================================
>Function get_func_rng(func_str As String) As Range
>'input: func_str データ抽出のための関数式
>'out : get_func_rng 条件に合ったセル範囲
>  Dim rng As Range
>  With ThisWorkbook.Worksheets("sheet1")
>   Set rng = .Range("a1", .Range("a65536").End(xlUp))
>   End With
>  rng.Offset(0, 5).Formula = func_str
>  rng.Offset(0, 5) = rng.Offset(0, 5).Value
>  Set get_func_rng = rng.Offset(0, 5).SpecialCells(xlCellTypeConstants)
'  ↑上3行でF列を使っています、変更するなら5を別の数字に
>End Function
>'=========================================================
>Sub set_combo_item(cmb As MSForms.ComboBox, func_str As String)
>'input: cmb データをセットするコンボボックス
>'input: func_str データ抽出のための関数式
>  Dim rng As Range
>  Dim rng2 As Range
>  Set rng2 = get_func_rng(func_str)
>  cmb.Clear
>  For Each rng In rng2
>   cmb.AddItem rng.Value
>   Next
>  cmb.ListIndex = 0
>  rng2.Value = ""
>  Set rng = Nothing
>  Set rng2 = Nothing
>End Sub
>
>
>次にシート2のシートモジュールに
>'===========================================================
>Private Sub Worksheet_Activate()
>  UserForm1.Show vbModeless
>End Sub
>'===========================================================
>Private Sub Worksheet_Deactivate()
  Application.ScreenUpdating = False
>  Unload UserForm1
  Application.ScreenUpdating = True
>End Sub
>'===========================================================
>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>  With UserForm1
>    If .Visible = False Then .Show vbModeless
>    End With
>End Sub
>
>尚、シート2では、コマンドボタンクリック時にどこのセルを選択しても
>選択されたセルと同じ行のA列からデータが貼り付けられる仕様になっています。

【9701】Re:コンボボックスで選択、そしてまた次の...
質問  ぴ〜ちゃん  - 03/12/14(日) 0:40 -

引用なし
パスワード
   ichinose さん
ありがとうございます。
なぜか
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
のところで止まってしまい
エラーが出て動きません。自分なりに四苦八苦してるところです。
わかれば教えて頂きたいです
宜しくお願いします

>▼ぴ〜ちゃん さん:
>おはようございます。
>誤字とコード訂正です。
>
>>当該フォームモジュールに
>>'=========================================================
>>Private Sub UserForm_Initialize()
>>  Dim func_str As String
>>  func_str = "=if(countif(sheet1!$a$1:a1,a1)>1,"""",a1)"
>>  Call set_combo_item(ComboBox1, func_str)
>>  func_str = "=if(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1,"""")"
>>  Call set_combo_item(ComboBox2, func_str)
>>End Sub
>>'=========================================================
>>Private Sub ComboBox1_Change()
>>  Dim func_str As String
>>  func_str = "=if(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1,"""")"
>>  Call set_combo_item(ComboBox2, func_str)
>>End Sub
>>'=========================================================
>>Private Sub CommandButton1_Click()
>  Dim func_str As String
>  Dim rng As Range
>  Dim f_row As Long
>  Dim w_row As Long
>  func_str = "=if(and(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1=""" & ComboBox2.Text & """),row(),"""")"
>  Set rng = get_func_rng(func_str)
>  f_row = rng.Row
>  w_row = ActiveCell.Row
>  With Worksheets("sheet1")
>     Range(Cells(w_row, 1), Cells(w_row, 4)).Value _
>       = .Range(.Cells(f_row, 1), .Cells(f_row, 4)).Value
>    End With
>'一括で移行できるんだった
>  rng.Value = ""
>>End Sub
>>'=========================================================
>>Function get_func_rng(func_str As String) As Range
>>'input: func_str データ抽出のための関数式
>>'out : get_func_rng 条件に合ったセル範囲
>>  Dim rng As Range
>>  With ThisWorkbook.Worksheets("sheet1")
>>   Set rng = .Range("a1", .Range("a65536").End(xlUp))
>>   End With
>>  rng.Offset(0, 5).Formula = func_str
>>  rng.Offset(0, 5) = rng.Offset(0, 5).Value
>>  Set get_func_rng = rng.Offset(0, 5).SpecialCells(xlCellTypeConstants)
>'  ↑上3行でF列を使っています、変更するなら5を別の数字に
>>End Function
>>'=========================================================
>>Sub set_combo_item(cmb As MSForms.ComboBox, func_str As String)
>>'input: cmb データをセットするコンボボックス
>>'input: func_str データ抽出のための関数式
>>  Dim rng As Range
>>  Dim rng2 As Range
>>  Set rng2 = get_func_rng(func_str)
>>  cmb.Clear
>>  For Each rng In rng2
>>   cmb.AddItem rng.Value
>>   Next
>>  cmb.ListIndex = 0
>>  rng2.Value = ""
>>  Set rng = Nothing
>>  Set rng2 = Nothing
>>End Sub
>>
>>
>>次にシート2のシートモジュールに
>>'===========================================================
>>Private Sub Worksheet_Activate()
>>  UserForm1.Show vbModeless
>>End Sub
>>'===========================================================
>>Private Sub Worksheet_Deactivate()
>  Application.ScreenUpdating = False
>>  Unload UserForm1
>  Application.ScreenUpdating = True
>>End Sub
>>'===========================================================
>>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>>  With UserForm1
>>    If .Visible = False Then .Show vbModeless
>>    End With
>>End Sub
>>
>>尚、シート2では、コマンドボタンクリック時にどこのセルを選択しても
>>選択されたセルと同じ行のA列からデータが貼り付けられる仕様になっています。

【9703】Re:コンボボックスで選択、そしてまた次の...
お礼  ぴ〜ちゃん  - 03/12/14(日) 9:07 -

引用なし
パスワード
   ichinose さん
できました。
本当にありがとうございます。


>ichinose さん
>ありがとうございます。
>なぜか
>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>のところで止まってしまい
>エラーが出て動きません。自分なりに四苦八苦してるところです。
>わかれば教えて頂きたいです
>宜しくお願いします
>
>>▼ぴ〜ちゃん さん:
>>おはようございます。
>>誤字とコード訂正です。
>>
>>>当該フォームモジュールに
>>>'=========================================================
>>>Private Sub UserForm_Initialize()
>>>  Dim func_str As String
>>>  func_str = "=if(countif(sheet1!$a$1:a1,a1)>1,"""",a1)"
>>>  Call set_combo_item(ComboBox1, func_str)
>>>  func_str = "=if(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1,"""")"
>>>  Call set_combo_item(ComboBox2, func_str)
>>>End Sub
>>>'=========================================================
>>>Private Sub ComboBox1_Change()
>>>  Dim func_str As String
>>>  func_str = "=if(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1,"""")"
>>>  Call set_combo_item(ComboBox2, func_str)
>>>End Sub
>>>'=========================================================
>>>Private Sub CommandButton1_Click()
>>  Dim func_str As String
>>  Dim rng As Range
>>  Dim f_row As Long
>>  Dim w_row As Long
>>  func_str = "=if(and(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1=""" & ComboBox2.Text & """),row(),"""")"
>>  Set rng = get_func_rng(func_str)
>>  f_row = rng.Row
>>  w_row = ActiveCell.Row
>>  With Worksheets("sheet1")
>>     Range(Cells(w_row, 1), Cells(w_row, 4)).Value _
>>       = .Range(.Cells(f_row, 1), .Cells(f_row, 4)).Value
>>    End With
>>'一括で移行できるんだった
>>  rng.Value = ""
>>>End Sub
>>>'=========================================================
>>>Function get_func_rng(func_str As String) As Range
>>>'input: func_str データ抽出のための関数式
>>>'out : get_func_rng 条件に合ったセル範囲
>>>  Dim rng As Range
>>>  With ThisWorkbook.Worksheets("sheet1")
>>>   Set rng = .Range("a1", .Range("a65536").End(xlUp))
>>>   End With
>>>  rng.Offset(0, 5).Formula = func_str
>>>  rng.Offset(0, 5) = rng.Offset(0, 5).Value
>>>  Set get_func_rng = rng.Offset(0, 5).SpecialCells(xlCellTypeConstants)
>>'  ↑上3行でF列を使っています、変更するなら5を別の数字に
>>>End Function
>>>'=========================================================
>>>Sub set_combo_item(cmb As MSForms.ComboBox, func_str As String)
>>>'input: cmb データをセットするコンボボックス
>>>'input: func_str データ抽出のための関数式
>>>  Dim rng As Range
>>>  Dim rng2 As Range
>>>  Set rng2 = get_func_rng(func_str)
>>>  cmb.Clear
>>>  For Each rng In rng2
>>>   cmb.AddItem rng.Value
>>>   Next
>>>  cmb.ListIndex = 0
>>>  rng2.Value = ""
>>>  Set rng = Nothing
>>>  Set rng2 = Nothing
>>>End Sub
>>>
>>>
>>>次にシート2のシートモジュールに
>>>'===========================================================
>>>Private Sub Worksheet_Activate()
>>>  UserForm1.Show vbModeless
>>>End Sub
>>>'===========================================================
>>>Private Sub Worksheet_Deactivate()
>>  Application.ScreenUpdating = False
>>>  Unload UserForm1
>>  Application.ScreenUpdating = True
>>>End Sub
>>>'===========================================================
>>>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>>>  With UserForm1
>>>    If .Visible = False Then .Show vbModeless
>>>    End With
>>>End Sub
>>>
>>>尚、シート2では、コマンドボタンクリック時にどこのセルを選択しても
>>>選択されたセルと同じ行のA列からデータが貼り付けられる仕様になっています。

【18724】Re:コンボボックスで選択、そしてまた次...
質問  ぴ〜こ  - 04/10/7(木) 15:23 -

引用なし
パスワード
   よく似た質問がありましたので
返信にて質問させて下さい。
わからない箇所は、一番下の部分です。
VBA初心者です。宜しくお願いします。

▼ぴ〜ちゃん さん:
>ichinose さん
>できました。
>本当にありがとうございます。
>
>
>>ichinose さん
>>ありがとうございます。
>>なぜか
>>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>>のところで止まってしまい
>>エラーが出て動きません。自分なりに四苦八苦してるところです。
>>わかれば教えて頂きたいです
>>宜しくお願いします
>>
>>>▼ぴ〜ちゃん さん:
>>>おはようございます。
>>>誤字とコード訂正です。
>>>
>>>>当該フォームモジュールに
>>>>'=========================================================
>>>>Private Sub UserForm_Initialize()
>>>>  Dim func_str As String
>>>>  func_str = "=if(countif(sheet1!$a$1:a1,a1)>1,"""",a1)"
>>>>  Call set_combo_item(ComboBox1, func_str)
>>>>  func_str = "=if(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1,"""")"
>>>>  Call set_combo_item(ComboBox2, func_str)
>>>>End Sub
>>>>'=========================================================
>>>>Private Sub ComboBox1_Change()
>>>>  Dim func_str As String
>>>>  func_str = "=if(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1,"""")"
>>>>  Call set_combo_item(ComboBox2, func_str)
>>>>End Sub
>>>>'=========================================================
>>>>Private Sub CommandButton1_Click()
>>>  Dim func_str As String
>>>  Dim rng As Range
>>>  Dim f_row As Long
>>>  Dim w_row As Long
>>>  func_str = "=if(and(sheet1!a1=""" & ComboBox1.Text & """,sheet1!b1=""" & ComboBox2.Text & """),row(),"""")"
>>>  Set rng = get_func_rng(func_str)
>>>  f_row = rng.Row
>>>  w_row = ActiveCell.Row
>>>  With Worksheets("sheet1")
>>>     Range(Cells(w_row, 1), Cells(w_row, 4)).Value _
>>>       = .Range(.Cells(f_row, 1), .Cells(f_row, 4)).Value
>>>    End With
>>>'一括で移行できるんだった
>>>  rng.Value = ""
>>>>End Sub
>>>>'=========================================================
>>>>Function get_func_rng(func_str As String) As Range
>>>>'input: func_str データ抽出のための関数式
>>>>'out : get_func_rng 条件に合ったセル範囲
>>>>  Dim rng As Range
>>>>  With ThisWorkbook.Worksheets("sheet1")
>>>>   Set rng = .Range("a1", .Range("a65536").End(xlUp))
>>>>   End With
>>>>  rng.Offset(0, 5).Formula = func_str
>>>>  rng.Offset(0, 5) = rng.Offset(0, 5).Value
>>>>  Set get_func_rng = rng.Offset(0, 5).SpecialCells(xlCellTypeConstants)
>>>'  ↑上3行でF列を使っています、変更するなら5を別の数字に
>>>>End Function
>>>>'=========================================================
>>>>Sub set_combo_item(cmb As MSForms.ComboBox, func_str As String)
>>>>'input: cmb データをセットするコンボボックス
>>>>'input: func_str データ抽出のための関数式
>>>>  Dim rng As Range
>>>>  Dim rng2 As Range
>>>>  Set rng2 = get_func_rng(func_str)
>>>>  cmb.Clear
>>>>  For Each rng In rng2
>>>>   cmb.AddItem rng.Value
>>>>   Next
>>>>  cmb.ListIndex = 0
>>>>  rng2.Value = ""
>>>>  Set rng = Nothing
>>>>  Set rng2 = Nothing
>>>>End Sub
>>>>
>>>>次にシート2のシートモジュールに
>>>>'===========================================================
>>>>Private Sub Worksheet_Activate()
>>>>  UserForm1.Show vbModeless
>>>>End Sub
>>>>'===========================================================
>>>>Private Sub Worksheet_Deactivate()
>>>  Application.ScreenUpdating = False
>>>>  Unload UserForm1
>>>  Application.ScreenUpdating = True
>>>>End Sub
>>>>'===========================================================
>>>>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>>>>  With UserForm1
>>>>    If .Visible = False Then .Show vbModeless
>>>>    End With
>>>>End Sub
>>>>
>>>>尚、シート2では、コマンドボタンクリック時にどこのセルを選択しても
>>>>選択されたセルと同じ行のA列からデータが貼り付けられる仕様になっています。

上記のところのコマンドボタンクリック時にどこのセルを選択→セルの範囲内で
(たとえば、A列の4行目〜10行目)選択されたセルと同じ行のA列からデータが貼り付けられる仕様に変更したいのですが、どのようにすれば良いのでしょうか。
宜しくお願いします。

【18734】Re:コンボボックスで選択、そしてまた次...
発言  ichinose  - 04/10/7(木) 20:12 -

引用なし
パスワード
   ▼ぴ〜こ さん:
こんばんは。
どんな質問だったのか思い出すのに時間がかかってしまいました。
(プログラムの保守は、大変なのがわかります)

で、

>
>上記のところのコマンドボタンクリック時にどこのセルを選択→セルの範囲内で
>(たとえば、A列の4行目〜10行目)選択されたセルと同じ行のA列からデータが貼り付けられる仕様に変更したいのですが、どのようにすれば良いのでしょうか。
>宜しくお願いします。

この仕様がちょっとわかりませんでした。実例を出して説明していただけませんか?

例えば、Sheet1に

   A    B      C     D
1  東京都  渋谷区    10000人  14000人
2  東京都  新宿区    20000人  25000人
3  東京都  港区     50000人  55000人
4  茨城県  水戸市    20000人  20000人
5  茨城県  つくば市   25000人  25000人
6  茨城県  ひたちなか市 20000人  15000人  

というデータがあり、

ユーザーフォームには、コンボックスが二つ
 Combobox1 ----都道府県選択用
 Conbobox2 ----区市郡選択用
 コマンドボタン(Commandbutton1)検索&貼付用ボタン

だとして、

Combobox1で「東京都」選択、Combobox2で「港区」選択の状態で

Sheet2のセルA4〜A10を選択して、Commandbutton1をクリックして場合、

どのようにデータが設定されるとご希望の処理なのですか?


出来たら、2,3例挙げて下さい。

【18735】Re:コンボボックスで選択、そしてまた次...
質問  ぴ〜こ  - 04/10/7(木) 20:53 -

引用なし
パスワード
   ▼ichinose さん:
こんばんは、ありがとうございます。
質問がわかりにくくてすいませんでした。

>▼ぴ〜こ さん:
>こんばんは。
>どんな質問だったのか思い出すのに時間がかかってしまいました。
>(プログラムの保守は、大変なのがわかります)
>
>で、
>
>>
>>上記のところのコマンドボタンクリック時にどこのセルを選択→セルの範囲内で
>>(たとえば、A列の4行目〜10行目)選択されたセルと同じ行のA列からデータが貼り付けられる仕様に変更したいのですが、どのようにすれば良いのでしょうか。
>>宜しくお願いします。
>
>この仕様がちょっとわかりませんでした。実例を出して説明していただけませんか?
>
>例えば、Sheet1に
>
>   A    B      C     D
>1  東京都  渋谷区    10000人  14000人
>2  東京都  新宿区    20000人  25000人
>3  東京都  港区     50000人  55000人
>4  茨城県  水戸市    20000人  20000人
>5  茨城県  つくば市   25000人  25000人
>6  茨城県  ひたちなか市 20000人  15000人  
>
>というデータがあり、
>
>ユーザーフォームには、コンボックスが二つ
> Combobox1 ----都道府県選択用
> Conbobox2 ----区市郡選択用
> コマンドボタン(Commandbutton1)検索&貼付用ボタン
>
>だとして、
>
>Combobox1で「東京都」選択、Combobox2で「港区」選択の状態で
>
>Sheet2のセルA4〜A10を選択して、Commandbutton1をクリックして場合、
>
>どのようにデータが設定されるとご希望の処理なのですか?
>
>
>出来たら、2,3例挙げて下さい。


ユーザーフォームを作り、そこにコンボボックス1、
コンボボックス2を作ります。
シート1にコンボボックス1で都道府県名を選択し、
コンボボックス2で、1で選択した都道府県の「区市郡」
を選択できるようにします。
   A    B      C     D
1  東京都  渋谷区    10000人  14000人
2  東京都  新宿区    20000人  25000人
3  東京都  港区     50000人  55000人
4  茨城県  水戸市    20000人  20000人
5  茨城県  つくば市   25000人  25000人
6  茨城県  ひたちなか市 20000人  15000人      
.   .    .
.   .    .
.   .    .

シート2のA列の4〜10行目を選択するとフォームが表示されて
シート1で選択したコンボボックス1、コンボボックス2で
1で選択した都道府県の「区市郡」を
自動記入しコンボボックス2で選択した区市郡の人口 C、Dを
合わせて貼り付けたいのです。


シート2のA6(他のセルを選択した場合は、フォームは
表示しない)を選択した場合は、フォームが表示されて
コンボボックス1−東京、コンボボックス2−港区を選択した場合は
下記の用にしたいです。
   A    B      C     D
1 
2 
3 
4 
5 
6  東京都  港区     50000人  55000人 
よろしくお願いします

【18736】Re:コンボボックスで選択、そしてまた次...
発言  ichinose  - 04/10/7(木) 21:27 -

引用なし
パスワード
   ▼ぴ〜こ さん:
うーん、まだはっきり分かっていませんが・・・・。
私の想像がかなり入った例です。
まず、シート1のシートモジュールでは、
'=====================================================
Private Sub Worksheet_Activate()
  With UserForm1
   If .Visible = False Then .Show vbModeless
   End With
End Sub
'==============================================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  With UserForm1
   If .Visible = False Then .Show vbModeless
   End With
End Sub
↑このコードでシート1がアクティブになったり、セルを選択したりした動作で
フォームが表示されます。


次にシート2では、
'===============================================================
Private Sub Worksheet_Activate()
  Dim rng As Range
  Set rng = Selection
  If TypeName(rng) = "Range" Then
   Call rng_chk_and_form_show(rng)
   End If
 
End Sub

'===========================================================
Private Sub Worksheet_Deactivate()
  UserForm1.Hide
End Sub
'===========================================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Call rng_chk_and_form_show(Target)
End Sub
Sub rng_chk_and_form_show(rng As Range)
  If rng.Column = 1 And rng.Columns.Count = 1 Then
   UserForm1.Show vbModeless
  Else
   UserForm1.Hide
   End If
End Sub
↑これらのコードでA列を選択したときのみフォームが表示されます。

最後にユーザーフォームのモジュールに今まで私が投稿したコードに追加として、

'================================================================
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  UserForm1.Hide
  Cancel = True
End Sub

↑これで、シート1で選択したコンボボックスの内容が保持されます。

コマンドボタンのクリックで動作する仕様は変えていません。

こんな仕様では?

【18752】Re:コンボボックスで選択、そしてまた次...
お礼  ぴ〜こ  - 04/10/8(金) 20:55 -

引用なし
パスワード
   ichinose さん

こんばんは
なんとかできました。
ありがとうございます。
また宜しくお願いします


>▼ぴ〜こ さん:
>うーん、まだはっきり分かっていませんが・・・・。
>私の想像がかなり入った例です。
>まず、シート1のシートモジュールでは、
>'=====================================================
>Private Sub Worksheet_Activate()
>  With UserForm1
>   If .Visible = False Then .Show vbModeless
>   End With
>End Sub
>'==============================================================
>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>  With UserForm1
>   If .Visible = False Then .Show vbModeless
>   End With
>End Sub
>↑このコードでシート1がアクティブになったり、セルを選択したりした動作で
>フォームが表示されます。
>
>
>次にシート2では、
>'===============================================================
>Private Sub Worksheet_Activate()
>  Dim rng As Range
>  Set rng = Selection
>  If TypeName(rng) = "Range" Then
>   Call rng_chk_and_form_show(rng)
>   End If
> 
>End Sub
>
>'===========================================================
>Private Sub Worksheet_Deactivate()
>  UserForm1.Hide
>End Sub
>'===========================================================
>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>  Call rng_chk_and_form_show(Target)
>End Sub
>Sub rng_chk_and_form_show(rng As Range)
>  If rng.Column = 1 And rng.Columns.Count = 1 Then
>   UserForm1.Show vbModeless
>  Else
>   UserForm1.Hide
>   End If
>End Sub
>↑これらのコードでA列を選択したときのみフォームが表示されます。
>
>最後にユーザーフォームのモジュールに今まで私が投稿したコードに追加として、
>
>'================================================================
>Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
>  UserForm1.Hide
>  Cancel = True
>End Sub
>
>↑これで、シート1で選択したコンボボックスの内容が保持されます。
>
>コマンドボタンのクリックで動作する仕様は変えていません。
>
>こんな仕様では?

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