CSV出力の際に重複していたら上の行は書出し下の行はスルーしたい

Question

Excelで読み込んだデータをCSV出力しています。
その際に重複の場合に、最初の行を書出しほかの重複行は飛ばして書き出したいです。
その重複行はExcel上で行の削除したくありません。（次の処理で別CSVも作成しているため）
削除しか方法ないということであれば、書き出したCSVの重複行の削除の仕方はございますでしょうか？
ご教示お願いします。

↓14行目と15行目が重複しているので14行目だけを書込み、16行目以降もをかきだしていきたいです。

Private Sub CSV_Click()
    Dim i As Long
    Dim c As Long
    Dim j As Long
    Dim r As Long
    Dim re As Long
    Dim cnt As Long
    Dim csvFile1 As String
    Dim csvFile2 As String
    Dim FoundCell As Range

    r = Me.Range("C13").CurrentRegion(Me.Range("C13").CurrentRegion.Count).Row
    c = Me.Range("C13").CurrentRegion(Me.Range("C13").CurrentRegion.Count).Column

    If Me.Cells(8, 3).Value Like "*+*" Then
        csvFile1 = ActiveWorkbook.Path & "\" & "職員マスタ 1_" & Format(Now, "yyyymmdd_hhmmss") & ".csv"
        Open csvFile1 For Output As #1

            For i = 14 To r
                cnt = cnt + 1
                If cnt <= 1000 Then
                    For j = 3 To 12
                        If j <> 12 Then
                            Write #1, Me.Cells(i, j).Value;
                        Else
                            Write #1, Me.Cells(i, j).Value
                        End If
                    Next j
                Else
                    Close #1
                    csvFile2 = ActiveWorkbook.Path & "\" & "職員マスタ 2_" & Format(Now, "yyyymmdd_hhmmss") & ".csv"
                    Open csvFile2 For Output As #2
                    Exit For
                End If
            Next i
    
            If cnt > 1000 Then
                For i = i To r
                    For j = 3 To 12
                        If j <> 12 Then
                            Write #2, Me.Cells(i, j).Value;
                        Else
                            Write #2, Me.Cells(i, j).Value
                        End If
                    Next j
                Next i
            End If
           MsgBox Me.Cells(8, 3) & ".csv" & "を作成しました。"

下記のようにも書いてみたんですが、これだと重複行全部書き込まれません。。。

    If Me.Cells(8, 3).Value Like "*+*" Then
        csvFile1 = ActiveWorkbook.Path & "\" & "職員マスタ 1_" & Format(Now, "yyyymmdd_hhmmss") & ".csv"
        Open csvFile1 For Output As #1
            For Each rng In Range("C14:C" & r)
                
                CellCount = WorksheetFunction.CountIf( _
                        Range("C14", Cells(r, 3)), rng)
                If CellCount = 0 Then
                    For i = 14 To r
                        cnt = cnt + 1
                        If cnt <= 1000 Then
                            For j = 3 To 12
                                If j <> 12 Then
                                    Write #1, Me.Cells(i, j).Value;
                                Else
                                    Write #1, Me.Cells(i, j).Value
                                End If
                            Next j
                        Else
                            Close #1
                            csvFile2 = ActiveWorkbook.Path & "\" & "職員マスタ 2_" & Format(Now, "yyyymmdd_hhmmss") & ".csv"
                            Open csvFile2 For Output As #2
                            Exit For
                        End If
                    Next i
                End If
            Next rng

Comments

[Youbun]

画像の表を読み込んでCSVファイルを出力する
・１行ずつ見た時に「職員コード」に重複がある場合は
　上の行の方のみをcvsファイルに出力したい

という事をやりたいという質問であってますか？

[Naoko_Coco]

はい。その通りです。

[tatsu99]

提示されたソース（上のほう）をみると、
１．１２列（L列）まで、書いた後、改行をしていない。
２．CSV出力なら、各データををカンマ（,）で区切って出力すべきだが、カンマで区切って出力していない。
ように見えます。
本当に、このソースで、実行されたのでしょうか。
職員コードの重複以前に上記の修正が先決かと。

[Naoko_Coco]

それはやってます。Writeで12列目？に行ったときには改行してます。

[tatsu99]

Write #1, Me.Cells(i, j).Value;
最後の;を見落としていました。失礼しました。

[Naoko_Coco]

いえいえ、いつもありがとうございます。

Answer 1

Youbunさんのアドバイスに従ってDictionaryオブジェクトを使ってみました。
今回のケースでは連想配列のキーは職員コードですが、（重複の有無の判定だけなら）値は、1固定でも構いません。
出力するファイル名ですが、１秒以上かかると、まれに最後の秒のところで、ファイル名の秒台が合わなくなる可能性もあります。最初にFormat(Now, "yyyymmdd_hhmmss")タイムスタンプを取得しておき、その文字列を記憶し、それをファイルの番号が増えたとき使いまわすと良いでしょう。
今回は、この対応はしていません。

Private Sub CSV_Click()
    Dim i As Long
    Dim c As Long
    Dim j As Long
    Dim r As Long
    Dim re As Long
    Dim cnt As Long
    Dim csvFile As String
    Dim FoundCell As Range
    Dim fileNo As Long          'CSVファイル通番（1,2,3・・）
    Dim dicT As Object          '連想配列 キー：職員コード　値：最初に出現した行番号
    Dim key As String           '職員コード
    Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    
    r = Me.Range("C13").CurrentRegion(Me.Range("C13").CurrentRegion.Count).row
    c = Me.Range("C13").CurrentRegion(Me.Range("C13").CurrentRegion.Count).Column
    cnt = 0
    fileNo = 1
    If Me.Cells(8, 3).Value Like "*+*" Then
        csvFile = ActiveWorkbook.Path & "\" & "職員マスタ " & fileNo & "_" & Format(Now, "yyyymmdd_hhmmss") & ".csv"
        Open csvFile For Output As #1
        For i = 14 To r
            key = Me.Cells(i, 3).Value
            If dicT.exists(key) = False Then    '職員コードが既出でないなら出力する
                dicT(key) = i
                cnt = cnt + 1
                If cnt > 10000 Then
                    Close #1
                    fileNo = fileNo + 1
                    csvFile = ActiveWorkbook.Path & "\" & "職員マスタ " & fileNo & "_" & Format(Now, "yyyymmdd_hhmmss") & ".csv"
                    Open csvFile For Output As #1
                    cnt = 1
                End If
                For j = 3 To 12
                    If j <> 12 Then
                        Write #1, Me.Cells(i, j).Value;
                    Else
                        Write #1, Me.Cells(i, j).Value
                    End If
                Next j
            End If
        Next i
        Close #1
        MsgBox Me.Cells(8, 3) & ".csv" & "を作成しました。"
    End If
End Sub

Comments

[Naoko_Coco]

思い通りにできました！！
いつもありがとうございます。
色々と書き出してたらわけわからなくなっちゃったので、再度清書してみます。
ありがとうございました。

Answer 2

エクセルのフィルタオプション機能を使用して重複のないデータにしてからCSV書き出しをしてはいかがでしょうか？（必要であればそれ用にシートを作成する）

※上記操作はVBAで実装可能だと思いますが、試してはいません

Comments

[Naoko_Coco]

それが一番楽かもしれません！
Countifで重複があれば別シートにコピペでRemoveDuplicatesで重複削除してからCSVに書き出すのが、今自分でできる精いっぱいなのかもしれません。

Answer 3

＞その重複行はExcel上で行の削除したくありません。（次の処理で別CSVも作成しているため）
1）新たなブックにシート丸ごとコピー
2）そのまま重複の削除機能で重複の削除機能で重複削除
3）そのまま、名前を付けて保存（CSV形式）
4）新たなブックを保存せずに閉じる

とすればいいのでは？

Comments

[Naoko_Coco]

新しいシートにコピーしてってのは、やってみたらできました。
ありがとうございます。

[mattuwan]

新しいブックですけどね＾＾；
やってみたというのは手動でってことですか？

で、マクロ化したら使えそうですかね？

[Naoko_Coco]

マクロで重複があれば新しいシートにコピーしてRemoveDuplicatesにて重複削除してからCSVに書出し、作成したSheetは削除するってのをやりました。
ちゃんと動作してできましたよ。
ありがとうございます。

Answer 4

1.行の長さ分の配列を定義する
2.CSVファイルに出力した後、職員コードを「1.」で作成した配列に格納していくようにする
3.CVSに出力する前に、下記URLを参考に出力しようとしていた職員コードが「1.」で作成した配列の中に存在するか判定
指定の要素が配列に存在するか確認する関数

４.「配列に存在する＝すでに出力した職員コード」なので、CSVに出力する処理を行わないようにする

これで、重複判定は出来ると思います。

余談ですが、コードを見ていて思ったことを書きます。
・表を一度変数に格納してから操作すると早くてわかりやすい
セル範囲を配列に格納する方法
・CSVファイルに出力する時は、出力する文字列を1つの変数にまとめて一気に出力する
本当の表を見ていないのでよく分からないのですが、
Write関数で一セルずつ出力するのではなく、
職員マスタファイルとして出力する要素を、全て一つの変数に格納してから
出力したほうが見やすくて高速になると思います。

Comments

[Youbun]

今回は、新しいことを言ったらわけわからなくなると思って配列を使いましたが、
重複判定する時はDictionaryオブジェクトというものがとても便利なので
追記でご紹介しておきます。
https://www.sejuku.net/blog/29736
余裕があったら見てみてください！

[Naoko_Coco]

ありがとうございます。
書き換えたのですがインデックスが有効ではないと出てしまいます。
書き方が悪いんだと思うんですが自分でわかりません。。。
かこったりがわからないのでベタ打ちになりますが、見づらかったらすいません。
Dim varArray() As Variant
Dim varResult As Variant
Dim strTarget As String
　Open csvFile1 For Output As #1
’配列に格納
c = 0
For i = 14 To r
cnt = cnt + 1
If cnt <= 1000 Then
For j = 3 To 12
　　　　　　　　　varArray(c) = Me.Cells(i, j)
　　　　　　　　　c = c + 1
Next j
strTarget = Me.Cells(i, 3)
　　　　　　　　　 varResult = Filter(varArray, strTarget)
'
If UBound(varResult) = -1 Then
For c = 0 To 9
If c <> 9 Then
Write #1, varArray(c).Value;
Else
Write #1, varArray(c).Value
End If
Next
End If

Else

[Youbun]

質問に貼ってるやつも含めてですが、
・私の読解力不足
・コードが表のフォーマットに依存しすぎている
・表のフォーマットがわからない
・Private Sub CSV_Click()の関数が最後まで貼られていない
上記理由のため、
何を意図してこのソースを組んでるのか私にはよく分かりませんでした。
上のコードも何がしたいのか全く分かりませんでした。
なのであなたの書いたコードの修正は出来ないです。
やり方しか教えれなくてすみません。

[Naoko_Coco]

いえいえこちらこそ、色々と教えてくださりありがとうございます。
色々と分岐させたりしているので全コード載せるととても長くなってしまうため抜粋しました。書き方が悪くてすいませんでした。
今後ともよろしくお願いします。
今回はtatsu99さんが提案してくださった方法でうまくいきました。