| |
よく似た質問がありましたので
返信にて質問させて下さい。
わからない箇所は、一番下の部分です。
ＶＢＡ初心者です。宜しくお願いします。
▼ぴ〜ちゃん さん：
>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)
>>>' ↑上３行でＦ列を使っています、変更するなら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では、コマンドボタンクリック時にどこのセルを選択しても
>>>>選択されたセルと同じ行のＡ列からﾃﾞｰﾀが貼り付けられる仕様になっています。
上記のところのコマンドボタンクリック時にどこのセルを選択→セルの範囲内で
（たとえば、Ａ列の４行目〜１０行目）選択されたセルと同じ行のＡ列からﾃﾞｰﾀが貼り付けられる仕様に変更したいのですが、どのようにすれば良いのでしょうか。
宜しくお願いします。
|
|
ぴ〜こ
- 04/10/7(木) 15:23 -
