[[20180929145831]]　『オートフィルタとチェックボックス』（まちろん）　ページの最後に飛ぶ

『オートフィルタとチェックボックス』（まちろん）

エクセルマクロにて
下記のような表があります。

□あいうえお
☑かきくけこ
□さしすせそ
☑たちつてと

チェックボックスにチェックをつけた列のデータを別シートに
転記したいです。
表のデータが膨大なので、オートフィルタで該当する条件のデータを
絞り込んでチェックをつけて、転記というようにしたいのですが、
オートフィルタで絞り込むとチェックボックスがセルに固定されず
ずれてしまいます。

フォームコントロールで作成したチェックボックスを
セルに固定してオートフィルタをかけることはできますでしょうか？

＜使用 Excel：Excel2007、使用 OS：Windows7 ＞

チェックボックスの替わりに1でも入力してオートフイルターしては
だめですか

（隠居じーさん） 2018/09/29(土) 15:26

うっ　＾＾；；；　なにかわたしの勘違いでしたら
無視してください。
すみません
m(__)m

（隠居じーさん） 2018/09/29(土) 15:33

御返事有難うございます。
今、先にチェックボックスにチェックをつけて
別シートに転記するところまではマクロで
作成してしまっていて
後からオートフィルタを追加したいと思っている
状況です。

例えば、後から　あいうえおはチェックをつけていたかな？
というのを調べたいときにオートフィルタで検索できるようにしたいです。
（まちろん） 2018/09/29(土) 15:36

回答ではないのですが
よろしければ、↓のマクロを提示していただけませんか。

＞今、先にチェックボックスにチェックをつけて
＞別シートに転記するところまではマクロで
＞作成してしまっていて

（マナ） 2018/09/29(土) 15:54

'//

Sub transferBychkbox()

Sheets("受注一覧").Rows("3:" & Rows.Count).Clear

 Dim i As Long, j As Long, k As Long
 j = 3 'jは元データ(転記したいデータ)の最初の行(1行目はタイトル行のため2行目から指定)
k = 3 'kは転記先の最初の行(1行目はタイトルがあるので2行目から指定)

With ActiveSheet

  j = j - 1
    For i = 1 To .CheckBoxes.Count
         If .CheckBoxes(i) = xlOn Then
                 .Cells(j + i, 2).Resize(, 4).Copy Worksheets("受注一覧").Cells(k, 1)
                    k = k + 1
                    '.Cells(j + i, 2)の2は元データの最初の列(座標表示(縦(行)、横(列))
        End If
    Next
 End With
 End Sub
 '//
（まちろん） 2018/09/29(土) 16:10

宜しくお願い致します。
（まちろん） 2018/09/29(土) 16:16

チェックボックスの代わりに
セルのダブルクリックで、文字で☑□を表示させるのではだめですか
転記のマクロもオートフィルタで☑の行を抽出してコピーできます。

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Target.Column > 1 Then Exit Sub
    If Target.Row > 3 Then Exit Sub

    Cancel = True

    If Target.Value = ChrW(9745) Then
        Target.Value = "□"
    Else
        Target.Value = ChrW(9745)
    End If

 End Sub

 Sub transferBychkbox2()
    Dim wsS As Worksheet
    Dim wsD As Worksheet

    Set wsS = Worksheets("全データ")
    Set wsD = Worksheets("受注一覧")

    wsD.UsedRange.Clear

    With wsS.Range("A2").CurrentRegion
        .AutoFilter
        .AutoFilter 1, ChrW(9745)
        If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
            .Columns("B:E").Copy wsD.Range("A1")
        End If
        .AutoFilter
     End With

 End Sub

（マナ） 2018/09/29(土) 16:50

If Target.Row < 3 Then Exit Sub

の間違いでした

（マナ） 2018/09/29(土) 16:56

マナ様
したいことができました！！
ありがとうございました！！！
（まちろん） 2018/09/29(土) 17:37

コメント返信：

[ 一覧(最新更新順) ]

[[20180929145831]] 『オートフィルタとチェックボックス』（まちろん） ページの最後に飛ぶ

[[20180929145831]]　『オートフィルタとチェックボックス』（まちろん）　ページの最後に飛ぶ