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

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

ただいまの
回答率

90.50%

  • VBA

    2299questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1923questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

  • マクロ

    284questions

    定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

マクロで出力したCSVの最後に,,,が出てくる

受付中

回答 4

投稿

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

teryyyyy2

score 11

ご覧いただきありがとうございます。

ExcelVBAでの質問です。

データを取り込んだ後成形し、別ブックにCSV形式で保存するマクロなのですが
なぜかCSVに最終行に数行,,,とからの項目が出てしまします。
コードとして未熟な部分が多々ありますがなぜこうなるのかご教授ください。
単純に最終行から9999行を行削除してみたのですが消えませんでした。
コードを載せますのでご覧ください。
よろしくお願いします。

Option Explicit
'----- 参照設定 Microsoft CDO for Windows 2XXX Library
Public Const myADDRESS As String _
  = "http://schemas.microsoft.com/cdo/configuration/"

Public hi As String
Public strFileName As String
Dim gyo As Long
Dim gyo2 As Long
Dim filecount As Long
Dim sheetcount As Long
Dim unmatch As Long
Dim erfilecount As Long


'ボタンを押したとき
Sub FolderSelect()

    Dim LastRow As Long

    '最終行の指定

          LastRow = ThisWorkbook.Worksheets(4).Cells(Rows.Count, "B").End(xlUp).Row + 1

          ThisWorkbook.Worksheets(4).Range("A1:K" & LastRow).ClearContents

    Dim folderpass As String
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show = True Then
            folderpass = .SelectedItems(1)
        Else
            ThisWorkbook.Worksheets(1).Range("B3").Value = "キャンセルしました。"
            Exit Sub
        End If
    End With

    filecount = 0
    sheetcount = 0
    unmatch = 0
    erfilecount = 0
    gyo = 6
    gyo2 = 2


    ThisWorkbook.Worksheets(1).Range("B2").Value = "処理中"

    Call FileSearch(folderpass, "*.csv")
   Dim dateupdate As String
   dateupdate = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日更新"

   ThisWorkbook.Worksheets(1).Range("B2").Value = "完了"
   ThisWorkbook.Worksheets(2).Activate
End Sub
'ファイル検索
Sub FileSearch(Path As String, Target As String)
    Dim FSO As Object, Folder As Variant, File As Variant
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set File = FSO.getfile(Path)

            filecount = filecount + 1
            ThisWorkbook.Worksheets(1).Cells(gyo, 1) = File.Name
            ThisWorkbook.Worksheets(1).Cells(gyo, 2) = File.Path
            Call ParCopy(File.Path)

    ThisWorkbook.Worksheets(1).Range("B3").Value = filecount & "個のファイルが見つかりました。"
    'Next File
End Sub
''一覧出力
Sub ParCopy(Path As String)


    Dim openbook As Workbook
    Dim openbooksheet As Worksheet
    Dim lp As Long
    Dim el As Long
    Dim lo As Long
    Dim br As String
    Dim c As Range, Target As Range
    Dim LastRow As Long
    Dim FSO As Object
    Dim FileName_InFolder As String

        LastRow = ThisWorkbook.Worksheets(2).Cells(Rows.Count, "B").End(xlUp).Row + 1

        ThisWorkbook.Worksheets(2).Range("A1:K" & LastRow).ClearContents

        Application.ScreenUpdating = False

        On Error GoTo myError
        Set openbook = Application.Workbooks.Open(Path)


        'シートを格納

            Set openbooksheet = openbook.Worksheets(1)
            openbooksheet.Unprotect


        '最終行の指定

            LastRow = openbooksheet.Cells(Rows.Count, "B").End(xlUp).Row + 1


        'マクロ側へのコピペ
        'データを持ってきて
            openbooksheet.Range("A1:K" & LastRow).Copy ThisWorkbook.Worksheets(4).Range(ThisWorkbook.Worksheets(4).Cells(1, 1), ThisWorkbook.Worksheets(4).Cells(1, 1))

            el = 2

            Do Until el = LastRow

                If ThisWorkbook.Worksheets(4).Cells(el, "C") = "xxx" Then

                    ThisWorkbook.Worksheets(4).Rows(el).Delete

                End If

                el = el + 1

            Loop


          '左三列を値貼り付けして

            ThisWorkbook.Worksheets(4).Range("L1:N" & LastRow).Copy
            ThisWorkbook.Worksheets(2).Range(ThisWorkbook.Worksheets(2).Cells(1, 1), ThisWorkbook.Worksheets(2).Cells(1, 1)).PasteSpecial Paste:=xlPasteValues

          '残りを持ってくる..
            ThisWorkbook.Worksheets(4).Range("E1:K" & LastRow).Copy ThisWorkbook.Worksheets(2).Range(ThisWorkbook.Worksheets(2).Cells(1, 4), ThisWorkbook.Worksheets(2).Cells(1, 4))

            openbook.Close False


            LastRow = ThisWorkbook.Worksheets(5).Cells(Rows.Count, "G").End(xlUp).Row
            ThisWorkbook.Worksheets(5).Range("G1:P" & LastRow).Copy

            LastRow = ThisWorkbook.Worksheets(2).Cells(Rows.Count, "E").End(xlUp).Row + 1
            ThisWorkbook.Worksheets(2).Range(ThisWorkbook.Worksheets(2).Cells(LastRow, 1), ThisWorkbook.Worksheets(2).Cells(LastRow, 1)).PasteSpecial Paste:=xlPasteAll

            '誕生日が入って無い人を消す

            el = LastRow

             Do Until el = 2


                If Range("I" & el) = "" Then

                   ThisWorkbook.Worksheets(2).Rows(el).Delete

                End If

                el = el - 1

              Loop

            el = 7

            '日付の型を変更

            Do Until el = 10

               lo = 2

               Do Until lo = LastRow


                 ThisWorkbook.Worksheets(2).Cells(lo, el).NumberFormatLocal = "yyyy/mm/dd"

                 lo = lo + 1

               Loop

               el = el + 1

            Loop

            lp = LastRow + 9999

            ThisWorkbook.Worksheets(2).Rows(LastRow & ":" & lp).Delete


            Call test02




    Application.ScreenUpdating = True
    Exit Sub

myError:
    MsgBox Err.Description
    erfilecount = erfilecount + 1
    Application.ScreenUpdating = True
End Sub

 'Sheet2での退職者区分け


      Sub test02()



         Dim wb1 As Workbook
         Dim i As Long
         Dim s As Long
         Dim mo As String
         Dim td As String
         Dim FileName_InFolder As String
         Dim LastRow As Long

         Dim strYYYYMMDD As String

         'Now関数で取得した現在日付をFormatで整形して変数に格納

         strYYYYMMDD = Format(Now, "yyyymmdd")

         '最終行の取得

         LastRow = ThisWorkbook.Worksheets(2).Cells(Rows.Count, "B").End(xlUp).Row + 1

         i = 2

         td = ThisWorkbook.Worksheets(2).Cells(i, "K")

        Do Until i = LastRow

         mo = ThisWorkbook.Worksheets(2).Cells(i, "A")

         If ThisWorkbook.Worksheets(2).Cells(i, "H") <> "" Then


            ThisWorkbook.Worksheets(2).Cells(i, "C") = td

            ThisWorkbook.Worksheets(2).Cells(i, "B") = mo & "退職"

         End If

            i = i + 1

        Loop

          'ヘッダーの削除

          ThisWorkbook.Worksheets(2).Rows(1).Delete

        'CSVで別ファイル保存
        Set wb1 = ThisWorkbook

         mo = strYYYYMMDD
         Workbooks.Add.SaveAs Filename:=mo, FileFormat:=xlCSV
         wb1.Worksheets(2).Copy After:=Workbooks(mo & ".csv").Worksheets(1)
         Workbooks(mo & ".csv").Save
         Workbooks(mo & ".csv").Saved = True
         Workbooks(mo & ".csv").Close


      End Sub

毎回未熟な質問で申し訳ありません。
皆様のお力をお貸しください。
Excelは2013を使用しております。

  • 気になる質問をクリップする

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

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

    クリップを取り消します

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

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

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

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

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

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

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

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

    質問の評価を下げる

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

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

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

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

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

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

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

    詳細な説明はこちら

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

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

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

回答 4

+1

私も細かいアルゴリズムまでは理解していませんが、エクセルは一度入力があった箇所は消しても認識している場合があります。
ですので、見た目上は10行しかなくても、エクセル的には最終行は13行目として認識しているというケースはたまに起こります。

ですので、入力の形式が決まっているのであれば、それに該当しない行は処理しないとかすれば解決すると思います。例えば、1列目が空白なら処理しないみたいな

それ以外のちゃんとしたやり方は下記を参考にしてみてください。
ExcelVBAで最終行を誤認する問題の回避方法

投稿

編集

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

0

検証したところ、最初の私の回答が間違いであることを確認いたしました。
大変申し訳ございませんでした。

混乱防止のため、消去したしました。

投稿

編集

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

0

'+1はインデックスを考慮した場合、インデックスがないのなら不要です
LastRow = ThisWorkbook.Worksheets(4).Cells(Rows.Count, "B").End(xlUp).Row + 1

ここで最終行を取得していますが、そこで更に一行足していますね。おそらく、元の手本にした数式は先頭の見出し(インデックス行)も含めて表示していたのではないでしょうか(+1というのはインデックス行も足しているためです)。先頭行から値が入っているのなら、+1は不要なので消してください。

,,,,というのは値の入っている最終行の次の行を見に行っている証拠です。

投稿

編集

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

0

ども。。。

シート上の意図するデータ範囲と、
罫線や数式、あるいはセルの書式設定が設定されているセル範囲とが
同じなのかどうなのかわかりませんが、
(不要な行は削除しておいた方がよいでしょう。)
とりあえず、セル範囲が意図しないセル範囲として認識されるようなら、
セルの編集後(特にセル範囲の削除をした場合)、
つまり提示のコードで言うと、

'ヘッダーの削除
          ThisWorkbook.Worksheets(2).Rows(1).Delete

の後に、

Thisworkbook.Worksheets(2).UsedRange

と、呪文を唱えてみてはいかがでしょうか?

それで上手くいくなら、

'Sheet2での退職者区分け
Sub test03()
    Dim wshTarget As Worksheet  '操作対象シート
    Dim rngTarget As Range      '操作対象セル範囲
    Dim r As Range              '各行
    Dim mo As String            '日付?
    Dim td As String            '各人のID?

    Set wshTarget = ThisWorkbook.Worksheets("Sheet2")
    wshTarget.Rows(1).Delete
        Set rngTarget = wshTarget.UsedRange
    td = rngTarget.Range("K1").Value

    '行毎に見て処理をする
    For Each r In rngTarget.Rows
        With r
            mo = .Range("A1").Value
            If IsEmpty(.Range("H1").Value) = False Then
                .Range("C1").Value = td
                .Range("B1").Value = mo & "退職"
            End If
        End With
    Next

    '対象シートをCSV形式で保存
    wshTarget.Copy
    With Workbooks
        With .Item(.Count)
            .SaveAs Filename:=mo, FileFormat:=xlCSV
            .Close False
        End With
    End With
End Sub

また、
数式で処理できる作業のようなので、
列毎に数式を「一括」で入力することで、
VBAで繰り返しの処理を書かないようにすると、
処理速度の高速化が望めそうです。
(データ数が少なければ体感は変わらないかも知れませんが。)

もし、このコードで期待通りの結果が得られたなら、
「できた」で終わらずに、
個々の単語、個々の行を精査して、
意味が分からない、ところはどんどん質問して、
理解を深めていただけると幸いです。

そちらの理解度がどの程度かわからないので、
いちいち1から10まで解説するのは省略します。

最後に、
空白行を入れるのは、
それぞれの作業の分けの部分に入れる程度にした方が読みやすいです。
1画面に1つのプロシージャが入りきらないと、
スクロールを強いられ、作業性が悪くなると思います。
(読んでいて、コードが長くなる。あるいは変数の登場数が多くなる場合は、
プローシージャを分けるといいと思いました。)

あ、追記
あと、
「空白に見えるが空白でないセル」が存在する可能性があります。
そういったセルがあるなら、
置換機能や数式を利用して内容をクリアする必要があるかもしれません。
対象セル範囲を選択しジャンプ機能で空白セルを検索し、
間違いがないか確認してみてください。

投稿

編集

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

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

  • VBA

    2299questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1923questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

  • マクロ

    284questions

    定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。