質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.05%

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

解決済

回答 4

投稿

  • 評価
  • クリップ 0
  • VIEW 1,916

score 50

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
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • Naoko_Coco

    2019/10/08 15:08

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

    キャンセル

  • tatsu99

    2019/10/08 15:14

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

    キャンセル

  • Naoko_Coco

    2019/10/08 15:21

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

    キャンセル

回答 4

checkベストアンサー

+1

Youbunさんのアドバイスに従ってDictionaryオブジェクトを使ってみました。
今回のケースでは連想配列のキーは職員コードですが、(重複の有無の判定だけなら)値は、1固定でも構いません。
出力するファイル名ですが、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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/10/08 16:37

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

    キャンセル

+1

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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/10/08 16:22

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

    キャンセル

0

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

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

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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/10/08 15:19

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

    キャンセル

  • 2019/10/08 16:16 編集

    ありがとうございます。
    書き換えたのですがインデックスが有効ではないと出てしまいます。
    書き方が悪いんだと思うんですが自分でわかりません。。。
    かこったりがわからないのでベタ打ちになりますが、見づらかったらすいません。
    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

    キャンセル

  • 2019/10/08 16:28

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

    キャンセル

  • 2019/10/08 16:40

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

    キャンセル

0

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

とすればいいのでは?

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/10/08 16:38

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

    キャンセル

  • 2019/10/08 16:43

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

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

    キャンセル

  • 2019/10/08 17:00

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

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.05%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る