| |
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(日) 0:40 -
