Excel VBA質問箱 IV

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

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


62614 / 76732 ←次へ | 前へ→

【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列からデータが貼り付けられる仕様に変更したいのですが、どのようにすれば良いのでしょうか。
宜しくお願いします。

0 hits

【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 お礼

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