[[20170602150057]]　『VBAでフィルタ掛けた後　重複値に色をつける』（らら）　ページの最後に飛ぶ

『VBAでフィルタ掛けた後　重複値に色をつける』（らら）

いつもお世話になっております
教えていただけたら幸いです
下記の様に　フィルタかけていますが
抽出後M列に重複がある場合
色をつけたいですどの様にすればいいのでしょうか
宜しくお願いいたします

Private Sub ComboBox3_Change()
With ActiveSheet

    If Not .AutoFilterMode Then
        .Range("A1").AutoFilter
    Else
        If .FilterMode Then .ShowAllData
    End If
    .Range("A1").AutoFilter Field:=3, _
        Criteria1:="=*" & Me.ComboBox3.Text & "*"
End With
End Sub

＜使用 Excel：Excel2010、使用 OS：Windows10 ＞

最後　色をつけたのを貼り付けやり方を教えていただけないでしょうか？

 Sheets("main").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select

Sub Test1()
Sheets("main").Select
Selection.SpecialCells(xlCellTypeVisible).Select

  Selection.Copy

   Sheets("Sheet2").Select
  Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Dim i As Long, j As Long
For i = 1 To 18
For j = 13 To 13
If WorksheetFunction.CountIf(Range("m2:m18"), Cells(i, j)) > 1 Then
Cells(i, j).Interior.ColorIndex = 6
End If
Next j
Next i

Sheets("Sheet2").Select

     Range("A2", Cells(Rows.Count, "p").End(xlUp)).Select

    Selection.Copy

    Sheets("main").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select

End Sub
（らら） 2017/06/02(金) 16:55

 色を付けるとかそれ以前の問題だと思うのだけど・・・
 気になった点、メモ入れたのでもう一度自分で頑張ってみませんか？
    Sub Test1()
        Sheets("main").Select
        '■セルの選択がないので、求めた結果にならない場合がある
        '　Selectなしでコード組みなおしてみてはどうですか？
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("Sheet2").Select
        Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Dim i As Long, j As Long
        For i = 1 To 18
            For j = 13 To 13 '■13 to 13ってなんですか？ jのループなくして、Cells(i, "M")でいいのでは？
                If WorksheetFunction.CountIf(Range("m2:m18"), Cells(i, j)) > 1 Then
                    Cells(i, j).Interior.ColorIndex = 6
                End If
            Next j
        Next i
        Sheets("Sheet2").Select
        Range("A2", Cells(Rows.Count, "p").End(xlUp)).Select
        Selection.Copy '■コピーした後、何もしていないようですが、何がしたいのですか？
        Sheets("main").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    End Sub

（稲葉） 2017/06/02(金) 18:44

稲葉様

仕事と仕事の合間
なるべく　今はなるべく　頭だけで書き直さないようにやってるもので

後で修正すればいい感じで　とりあえず動いてるから
いいかなって思ってます

Sheet　　mainはフィルター掛かってる状態で戻すだけなんですけどね

ここが　うまく選択できないだけなんです
（らら） 2017/06/02(金) 18:59

 推測しかできないけど、こういうことであってるの？
    Private Sub ComboBox3_Change()
        With Sheets("main")
            If Not .AutoFilterMode Then
                .Range("A1").AutoFilter
            ElseIf .FilterMode Then
                .ShowAllData
            End If
            .Range("A1").AutoFilter _
                Field:=3, _
                Criteria1:="=*" & Me.ComboBox3.Text & "*"
        End With
    End Sub

    Sub Test1()
        Dim r As Range
        Dim rr As Range
        With Sheets("main")
            .Select
            .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Select.Copy
        End With
        With Sheets("Sheet2")
            .Select
            .Range("A1").PasteSpecial Paste:=xlPasteValues
            Set rr = Range("M2", .Cells(.Rows.Count, "M").End(xlUp))
            For Each r In rr
                If WorksheetFunction.CountIf(rr, r.Value) > 1 Then
                    r.Interior.ColorIndex = 6
                End If
            Next i
            .Range("A2", Cells(Rows.Count, "p").End(xlUp)).Copy
            '■コピーした後、結局何がしたいのかわかりません。
        End With
        Sheets("main").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    End Sub
（稲葉） 2017/06/02(金) 19:22

コメント返信：

[ 一覧(最新更新順) ]

[[20170602150057]] 『VBAでフィルタ掛けた後 重複値に色をつける』（らら） ページの最後に飛ぶ

[[20170602150057]]　『VBAでフィルタ掛けた後　重複値に色をつける』（らら）　ページの最後に飛ぶ