[[20150514142958]]　『CSVを作成するマクロ』（初心者）　ページの最後に飛ぶ

『CSVを作成するマクロ』（初心者）

「あるxlsmファイル」のsheet1にA1～A1000000くらいまでデータが埋まっています。
A列以外やsheet1以外にデータはありません。
それぞれのセルに入っているのは、英単語や日本語の単語で重いデータではありません。

そのデータを先頭(A1)から3000ごとに分けて、別々のCSVに保存するというマクロを作りたいと思っています。

イメージとしては以下のようになります。

「あるxlsmファイル」の ..... A1～A3000は、00001.csvのA1～A3000に保存する。
「あるxlsmファイル」のA3001～A6000は、00002.csvのA1～A3000に保存する。

CSVファイルを大量に生成することになるので、5ケタの連番で上記のイメージのようにCSVにファイル名を付けます。

データはA1～A1000000もあるとは限らず、9050ぐらいしかない場合もあります。その場合は、1-3000,3001-6000,6001-9000,9001-9050のように最後のCSVファイルには余りを入れれば大丈夫です。

保存先はとりあえず、デスクトップにある、DATAというフォルダにしようと思っていますが、少しプログラムを書き換えれば、変更できるようにしていただけると助かります。

3000ごとに分けるのではなく、1000ごとや、10000ごとなど、少しプログラムを書き換えれば、変更できるようにしていただけると助かります。

よろしくおねがいします。

＜使用 Excel：unknown、使用 OS：unknown ＞

こんにちは

Transpose には要素数制限があるので注意が必要かと思いますけど、

Sub test()

    Dim r   As Range
    Dim i   As Long
    Dim j   As Long
    Dim k   As Long
    Dim v   As Variant
    Dim fn  As Long
    Dim f   As String

    Const s As Long = 3000
    f = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\DATA\"

    j = Range("A1").CurrentRegion.Rows.Count
    k = 1

    For i = 1 To j Step s
        If j - i + 1 < s Then
            v = Application.WorksheetFunction.Transpose(Cells(i, 1).Resize(j - i + 1).Value)
        Else
            v = Application.WorksheetFunction.Transpose(Cells(i, 1).Resize(s).Value)
        End If
        fn = FreeFile()
        Open f & Format(k, "00000") & ".CSV" For Output As #fn
        Print #fn, Join(v, vbCrLf)
        Close #fn
        k = k + 1
    Next
End Sub

（ウッシ） 2015/05/14(木) 16:07

すばらしいです！うまくできました！ありがとうございます。！

3点ほどお伺いしたいことがあります。

1点目

 ＞Transpose には要素数制限があるので注意が必要かと思いますけど、

これをもう少し具体的に教えていただけないでしょうか。できるだけ汎用性の高いコードが理想的です。

汎用性が高いとは、古いバージョンのエクセルや、できれば今後リリースされるエクセルでも使えるものが理想的です。

HTMLでいえば、非推奨になるかもしれないマイナーなもの（関数など）や、終了してしまうかもしれないマイナーなもの（関数など）は避けるといった具合です。

あくまでも理想なので、難しい場合は無視していただいて構いません。

2点目

＞ f = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\DATA\"

この記述だと、デスクトップのフォルダ名を変更することは簡単にできますが、Dドライブに保存する可能性があることを考慮すると、私の能力ではすぐに変更することはできません。ウィンドウズの任意のディレクトリに保存するようなフルパスで指定していただくことはできないでしょうか？

あくまでも理想なので、難しい場合は無視していただいて構いません。

3点目

DATAフォルダの中に出来上がったCSVを一つのCSVに連結させるマクロも、必要だということが発覚しました。

DATAフォルダの中には連番のファイル名があり、ファイル名の若いほうから、結合して一つのCSVにまとめ上げる感じです。まとめ上げた一つのCSVは「all.csv」というファイル名にします。

ただし、今回はA列以外の列にもにもデーターが入っています。

イメージとしては以下のようになります。

00001.csvの行1～行3000は、all.csvの........1行～行3000に保存する。
00002.csvの行1～行3000は、all.csvの3001行～行6000に保存する。

もう少し汎用性を高めると、イメージとしては以下のようになります。

00001.csvの行1～行1111は、all.csvの........1行～行1111に保存する。
00002.csvの行1～行9999は、all.csvの1112行～行10111に保存する。10111=1111+9999

つまり、00001.csv、00002.csvなどの「データが入っている最初の行」から「データが入っている最後の行」までをall.csvにコピペしていく感じです。

仮に、行1～行3000などの間に空白の行があっても、「データが入っている最初の行」から「データが入っている最後の行」までをall.csvにコピペしていきます。

実際に前回作っていただいたマクロが3000以外にも容易に変更できるようにしていただいたことや、最後のCSVは余りを入れることを考えると、こちらの形式でないと難しいと思います。

あとall.csvの保存先もウィンドウズの任意のディレクトリに保存できるような形式にしていただけると理想です。とりあえずは、デスクトップ（デスクトップにあるDATAというフォルダではなく、デスクトップそのもの）にしていただけると幸いです。

長くなってしまいましたが、どうぞよろしくおねがいします。
（初心者） 2015/05/14(木) 22:22

申し訳ありません。訂正です。

誤
00001.csvの行1～行1111は、all.csvの........1行～行1111に保存する。
00002.csvの行1～行9999は、all.csvの1112行～行10111に保存する。10111=1111+9999

正
00001.csvの行1～行1111は、all.csvの........1行～行1111...に保存する。
00002.csvの行1～行9999は、all.csvの1112行～行11110に保存する。11110=1111+9999

よろしくおねがいします。
（初心者） 2015/05/14(木) 22:27

こんにちは

65536 を超える数値を指定するとエラーになると思います。

古いバージョンのExcelなら行数自体が 65536行なのでそれより大きい数値を
指定する事はないですよね？

新しいヴァージョンについては行数は十分有りますけど、65536 を超える数値を
指定する可能性があるなら使えません。

古いバージョンのExcelも使う予定なら、指定出来る数値を65536以下とすべきだと思います。

Sub test1()

    Dim r   As Range
    Dim i   As Long
    Dim j   As Long
    Dim k   As Long
    Dim v   As Variant
    Dim fn  As Long
    Dim f   As Variant

    Const s As Long = 3000

' f = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\DATA\"

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            f = .SelectedItems(1) & "\"
        End If
    End With

    If IsEmpty(f) Then MsgBox "フォルダが選択されませんでした。": Exit Sub

    j = Range("A1").CurrentRegion.Rows.Count
    k = 1

    For i = 1 To j Step s
        If j - i + 1 < s Then
            v = Application.WorksheetFunction.Transpose(Cells(i, 1).Resize(j - i + 1).Value)
        Else
            v = Application.WorksheetFunction.Transpose(Cells(i, 1).Resize(s).Value)
        End If
        fn = FreeFile()
        Open f & Format(k, "00000") & ".CSV" For Output As #fn
        Print #fn, Join(v, vbCrLf)
        Close #fn
        k = k + 1
    Next
End Sub

3点目は後ほど

（ウッシ） 2015/05/15(金) 08:26

 横から失礼。

 ドライブ直下のフォルダであれば c:\hoge あるいは d:\hoge\hogehoge といったように記述すれば問題ないですね。
 ただ、デスクトップであったり、ドキュメントであったり、そういうものは

 c:\ユーザ\hogehogehoge\DeskTop 等、前に　c:\ユーザ\hogehogehoge\　がつきます。
 ここで、　hogehgehoge は　ログインユーザのアカウントになりますので、ＰＣが違うと、値も異なります。
 ですから、そういうものは、固定でコードに書くのではなく、ウッシさんのコードのように「動的に取り出す」ことが必要です。
 さらに、c:\ユーザ\hogehogehoge\　この階層は、今はそうですが、将来、全く別の階層構成になるかもしれません。
 現に、XP までの環境では、全く異なる階層構成でした。ということは、今後 Win100 ぐらいになると、また違う構成になる可能性もあります。

 ですから、「動的に取得」する意義は、hogehogehoge を自動設定するほかに、パス階層も、その環境にあったものにしてくれるということがあります。

 フォルダ特定には、その他、ウッシさんから提示されている、フォルダ選択ダイアログで指定する、
 あるいは、今動いているマクロブックと同じフォルダ、あるいは、エクセル上に読み込んだ別のブックと同じフォルダ。
 こんな取得方法があります。

 以下はサンプルです。エクセル上に読み込んだ別ブックを BookA.xlsx としています。

 Sub Sample()
    'マクロブックと同じフォルダ
    MsgBox "このマクロブックのフォルダは " & ThisWorkbook.Path
    'エクセル上にひかられている特定ブックのフォルダ
    MsgBox "BookA.xlsxのフォルダは " & Workbooks("BookA.xlsx").Path
    '現在のログインユーザのユーザープロファイル領域
    MsgBox "ユーザープロファイルパスは " & Environ("USERPROFILE")
    '現在のログインユーザのデスクトップ
    MsgBox "DeskTop は　" & CreateObject("WScript.Shell").SpecialFolders("DeskTop")
    '現在のログインユーザのドキュメント
    MsgBox "ドキュメント は　" & CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
 End Sub

（β） 2015/05/15(金) 08:57

 もう１点。

 >>HTMLでいえば、非推奨になるかもしれないマイナーなもの（関数など）や、終了してしまうかもしれないマイナーなもの（関数など）は避けるといった具合です。

 気持ちはわかります。ただ、何がマイナーなのか、何がいずれ打ち切られるのか、それは誰にもわかりません。
 現に、2003までは【超メジャー】だった FileSerchオブジェクトが2007以降、スパッと打ち切られました。

（β） 2015/05/15(金) 09:02

こんにちは

フルパスを手で修正するなら（β）さんのレスのように

f = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\DATA\"
を
f = "d:\hoge\hogehoge\DATA\"

にして下さい。

3点目

集約元データは名前順にして全選択して下さい。

Sub test2()

    Dim v   As String
    Dim fn  As Long
    Dim f   As Variant
    Dim a   As Variant
    Dim o   As Object

    f = Application.GetOpenFilename("CSV Files (*.csv), *.csv", , "集約元データを選択して下さい。", , True)

    If IsArray(f) = False Then
        MsgBox "ファイルが選択されませんでした。": Exit Sub
    End If

    v = Join(f, " + ")

    MsgBox "集約データの保存フォルダを選択して下さい。"

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            a = .SelectedItems(1) & "\"
        End If
    End With

    If IsEmpty(a) Then MsgBox "フォルダが選択されませんでした。": Exit Sub

    fn = FreeFile()
    Open a & "all.CSV" For Output As #fn
    Close #fn

    Set o = CreateObject("WScript.Shell")

    o.Run ("cmd.exe /c copy /B " & v & " " & a & "all.CSV")

End Sub

名前順に結合出来ないかも知れませんので、集約元データ名を昇順に並び替える処理が必要かも
知れません。

（ウッシ） 2015/05/15(金) 11:27

ありがとうございます。大変感謝しております。

現在、「分割するマクロ」と「結合するマクロ」を作っていただきましたが、それぞれについて、お伺いしたいことがあります。

何度も何度も申し訳ありません。

================================================================================

Windowsのショートカットキーの[CTRL] + [SHIFT] + [N] を使うと、デスクトップに「新しいフォルダー」「新しいフォルダー (2)」などの新規フォルダが一瞬で作成できることが分かったので、フォルダを選択する形式は使わずに、あらかじめフォルダを指定する方針にします。

せっかく作っていただいたのに申し訳ありません。いずれこのような選択するマクロが必要になると思うので、参考にさせて頂きます。

「分割するマクロ」と「結合するマクロ」ともに、フォルダを選択する形式は使わずに、あらかじめフォルダを指定する方針にします。

「DATA」ではなく、「新しいフォルダー」「新しいフォルダー (2)」などの新規フォルダを毎回作ることにいたします。

このほうがシンプルで、作業的にも効率が良いとわかりました。

==================================================================================

「分割するマクロ」について

「A列にあるデータを」CSVにするマクロを作っていただきましたが、少し変更して、「選択している列を」CSVにするマクロにしていただけないでしょうか。

選択は必ず、列全体を選択します。D列を選択する場合、「D1:D1048576」ではなく、「D:D」とします。つまり、マウスを物理的に、D列のDという場所の上に置き、クリックします。

また、必ず1列のみを選択します。たとえば、A列とD列を同時に選択するということはありません。

素人なりにお役に立てるかもしれないと思い、下記のページを探しました。意味ないかもしれませんが・・・

エクセルVBAについて質問です。エクセルで指定した範囲のURLを… = 人力検索はてな
http://q.hatena.ne.jp/1231783552

==================================================================================

「結合するマクロ」について

頂いたコードで試してみましたが、all.csvが何もデータが入っていないCSVになってしまいます。

前述のとおり、フォルダを選択する形式は不要になりました。

したがって、

デスクトップにある「新しいフォルダー」のなかに、00001.CSV、00002.CSVなどが入っており、それらを一つにまとめた、all.csvをデスクトップに作成する。

というようなもので、大丈夫です。

また、all.csvは、00001.CSV、00002.CSVなどを網羅していることが重要なので、順番は考慮しなくても問題ありません。00001.CSV、00002.CSVなどのCSVがたくさんありますが、どのCSVからall.csvにコピペしていっても、問題ありません。

ただし網羅性はとても大切で、00001.CSVのなかの1列が欠けていた、00002.CSVはコピペされなかった、というようなことは、困ります。

==================================================================================

たびたび申し訳ありませんが、どうぞよろしくおねがいします。

（初心者） 2015/05/16(土) 19:50

 横から失礼します。

(1)

  > 「DATA」ではなく、「新しいフォルダー」「新しいフォルダー (2)」などの
  >  新規フォルダを毎回作ることにいたします。 
  >  このほうがシンプルで、作業的にも効率が良いとわかりました。 
 私は必ずしも同意しませんが、
 もしそうお考えなら、あなたがその都度、コードを修正すれば済むことですね。

(2)

 > 「A列にあるデータを」CSVにするマクロを作っていただきましたが、
 >  少し変更して、「選択している列を」CSVにするマクロにしていただけないでしょうか。

 myCol = Selection.Column
 とすれば、列番号がわかりますから、
 A列に固定している箇所を、
 myColに書き換えるとよいでしょう。

 ご自分で修正してみてはいかがですか？

(3)

 >「結合するマクロ」について 
 > 頂いたコードで試してみましたが、all.csvが何もデータが入っていないCSVになってしまいます。

 ちなみに、私が動かしましたら、きちんと作成されました。

 o.Run ("cmd.exe /c copy /B " & v & " " & a & "all.CSV")
 のところを

 Dim ss As String
 ss = "cmd.exe /c copy /B " & v & " " & a & "all.CSV"
 Debug.Print ss
 Stop
 o.Run ss
 などと変更し、
 ss が正当に作成されているか確認してみてはどうですか？

 > 集約元データは名前順にして全選択して下さい。 
 の注意点が守られていない予感がします。確認してみて下さい。

（γ） 2015/05/16(土) 20:36

ウッシさまへ

名前順にして全選択というのをマウスでやっていましたが、やり方を変えたら、うまくいきました！

つまり、「結合するマクロ」も機能しました！

しかしプログラムは知識がほとんどないので、修正などはできません。

もしよろしければではありますが、一つ前の私の投稿のように修正していただければ幸いです。

もちろん難しいようであれば、無視していただいて構いませんが、もう少しで完成するので、もったいなく思っています。

どうぞよろしくおねがいします。
（初心者） 2015/05/17(日) 11:36

こんにちは

γさんのレスのように修正してみましたか？　その上で、

Cells(i, 1)ろいう部分を、Cells(i, myCol)

にすればいいです。

また、

    j = Range("A1").CurrentRegion.Rows.Count

も、

    j = Selection.Cells(1, 1).End(xlDown).Row

のように変えて下さい。

（ウッシ） 2015/05/18(月) 08:04

γさま、ウッシさまへ

「分割するマクロ」(Sub bunkatsu()としました。)はお二人のアドバイスをもとに書き換えて、うまくいきました。本当にありがとうございました。下にコードを載せました。

「結合するマクロ」（ Sub ketsugou()としました。）は、お二人のアドバイスをもとに書き換えてみましたが、空白のall.csvが出来上がってしまいました。下にコードを載せました。

「結合するマクロ」の問題点として、以下を考えました。

・そもそも集約元データはあらかじめフォルダを指定するのは無理なのでしょうか？できれば、集約元データもあらかじめ指定しておきたいのですが・・・

・下のコードで、v = f　としたところが問題なのでしょうか。
v = Join(f, " + ")について、型が一致しませんという、エラーが出たので、プログラムがわからないなりに、勘でこうしました。コメントアウトも初めて知ったので、ただの勘です。

どうぞよろしくおねがいします。

 ==================================================================================

「分割するマクロ」について

 Sub bunkatsu()

    Dim r   As Range
    Dim i   As Long
    Dim j   As Long
    Dim k   As Long
    Dim v   As Variant
    Dim fn  As Long
    Dim f   As String

    Const s As Long = 3000
    f = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\新しいフォルダー\"

    myCol = Selection.Column

    j = Selection.Cells(1, 1).End(xlDown).Row
    k = 1

    For i = 1 To j Step s
        If j - i + 1 < s Then
            v = Application.WorksheetFunction.Transpose(Cells(i, myCol).Resize(j - i + 1).Value)
        Else
            v = Application.WorksheetFunction.Transpose(Cells(i, myCol).Resize(s).Value)
        End If
        fn = FreeFile()
        Open f & Format(k, "00000") & ".CSV" For Output As #fn
        Print #fn, Join(v, vbCrLf)
        Close #fn
        k = k + 1
    Next
End Sub

==================================================================================

「結合するマクロ」について

 Sub ketsugou()

    Dim v   As String
    Dim fn  As Long
    Dim f   As Variant
    Dim a   As Variant
    Dim o   As Object

    f = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\新しいフォルダー\"

    'f = Application.GetOpenFilename("CSV Files (*.csv), *.csv", , "集約元データを選択して下さい。", , True)

    'If IsArray(f) = False Then
    '    MsgBox "ファイルが選択されませんでした。": Exit Sub
    'End If

    'v = Join(f, " + ")

    v = f

    a = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\新しいフォルダー (2)\"

    'MsgBox "集約データの保存フォルダを選択して下さい。"

    'With Application.FileDialog(msoFileDialogFolderPicker)
    '    If .Show = True Then
    '        a = .SelectedItems(1) & "\"
    '    End If
    'End With

    'If IsEmpty(a) Then MsgBox "フォルダが選択されませんでした。": Exit Sub

    fn = FreeFile()
    Open a & "all.CSV" For Output As #fn
    Close #fn

    Set o = CreateObject("WScript.Shell")

    o.Run ("cmd.exe /c copy /B " & v & " " & a & "all.CSV")

End Sub

==================================================================================

（初心者） 2015/05/18(月) 11:48

こんにちは

意味も理解せずにコードを変更して出来ないと言うには無しにしましょう。

無意味なコードや不必要なコードは書かないようにしています。
全てのコードに意味が有りますので、自力で修正するのは理解出来てからにして下さい。

フォルダを指定して中のファイルを全て処理するなら、それなりのコードが必要です。

v = Join(f, " + ")　にも意味が有ります。

VBE画面で「Join」の部分をクリックしてF1キーでヘルプを読んでもいいですし、
「Excel VBA Join」等でWeb検索してもいいです。

（ウッシ） 2015/05/18(月) 12:08

ありがとうございます。

＞意味も理解せずにコードを変更して出来ないと言うには無しにしましょう。
そうですよね。

頂いたコードでも、実用に耐えうるので、このレスをもって、終わりにいたします。

ありがとうございました。
（初心者） 2015/05/18(月) 12:20

コメント返信：

[ 一覧(最新更新順) ]

[[20150514142958]] 『CSVを作成するマクロ』（初心者） ページの最後に飛ぶ

[[20150514142958]]　『CSVを作成するマクロ』（初心者）　ページの最後に飛ぶ