| |
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では、コマンドボタンクリック時にどこのセルを選択しても
>>>選択されたセルと同じ行のＡ列からﾃﾞｰﾀが貼り付けられる仕様になっています。
|
|
ぴ〜ちゃん
- 03/12/14(日) 9:07 -
