エクセルのマクロでCSVからxlsx形式にしてから

質問

A.csvというファイルをB.xlsx形式に変換後、列が10、行はランダム行あるファイルにフィルタをかけて
並び替えるような一連の動作ができるマクロはどのように作成すればよろしいでしょうか。
ご教示いただけますようお願いいたします。

回答No.1

Prome_Lin · ベストアンサー

「VBA」ではありませんので、無視して頂いて結構です（「VBScript」による回答ですので、「Windows限定」です）。

このプログラムの特徴は、「csv」ファイルを１つだけ、プログラムファイルにドラッグ＆ドロップすると、「csv」ファイルと同じフォルダ内に同じ名前（「abc.csv」→「abc.xlsx」）で、結果ファイルを保存します。

１行目が項目行で、列「A」について「小さい順にソート」し、列「D」の「みかん」で、「オートフィルタ」をかけています。

以下のプログラムを、メモ帳かテキストエディタに貼り付け、「～.vbs」という名前で保存します。

「～」の部分は、何でもかまいませんが、「.vbs」の部分は、必ず半角です。

できたプログラムファイル（「～.vbs」ファイル）に、これから処理したい、「csv」ファイルを１つだけ、ドラッグ＆ドロップするだけです。

最後に「Finished!」と表示しますので、「OK」を押して、終了してください。

Option Explicit
Dim bk, c, ex, f, n, r, sh, so, wa
Set so = CreateObject("Scripting.FileSystemObject")
Set wa = WScript.Arguments
If wa.Count <> 1 or LCase(so.GetExtensionName(wa(0))) <> "csv" Then
MsgBox("ドラッグ＆ドロップできるのは、csvファイル１つだけです")
WScript.Quit
End If
f = Left(wa(0), InStrRev(wa(0), "\"))
n = so.GetBaseName(wa(0))
Set ex = CreateObject("Excel.Application")
ex.Application.DisplayAlerts = False
ex.Visible = False
Set bk = ex.Workbooks.Open(wa(0))
Set sh = bk.Worksheets(1)
c = sh.Cells(1, sh.Columns.Count).End(-4159).Column
r = sh.Cells(sh.Rows.Count, 1).End(-4162).Row
sh.Range(sh.Cells(2, 1), sh.Cells(r, c)).Sort sh.Range("A2")
sh.Range(sh.Cells(1, 1), sh.Cells(r, c)).AutoFilter 4, "みかん"
bk.SaveAs f & n & ".xlsx", 51
bk.Close
ex.Quit
Set bk = Nothing
Set ex = Nothing
Set wa = Nothing
Set so = Nothing
MsgBox("Finished!")

簡単な説明です。

Option Explicit

「厳密に」というような意味ですが、気にしないでください。

Set so = CreateObject("Scripting.FileSystemObject")

ファイルやフォルダを扱えるようにしています。

Set wa = WScript.Arguments
If wa.Count <> 1 or LCase(so.GetExtensionName(wa(0))) <> "csv" Then
MsgBox("ドラッグ＆ドロップできるのは、csvファイル１つだけです")
WScript.Quit
End If

ドラッグ＆ドロップされるのを待っていて、ドラッグ＆ドロップされると、個数や拡張子を調べ、想定外なら、メッセージを表示して、プログラムそのものを終了してしまいます。

f = Left(wa(0), InStrRev(wa(0), "\"))

ドラッグ＆ドロップされたファイルの存在するフォルダを取得。

n = so.GetBaseName(wa(0))

ドラッグ＆ドロップされたファイルのベースネーム（「abc.csv」→「abc」）を取得。

Set ex = CreateObject("Excel.Application")

エクセルを扱えるようにしています。

ex.Application.DisplayAlerts = False
ex.Visible = False

「上書きしますか」などと聞いてこないように、また、エクセルを表示しません。

Set bk = ex.Workbooks.Open(wa(0))

ドラッグ＆ドロップされたファイルをエクセルのファイルとして開いています。

Set sh = bk.Worksheets(1)

一番左端のシートを「sh」にセット。

c = sh.Cells(1, sh.Columns.Count).End(-4159).Column

１行目に関して、最終列を取得。

r = sh.Cells(sh.Rows.Count, 1).End(-4162).Row

列「A」に関して、最終行を取得。

sh.Range(sh.Cells(2, 1), sh.Cells(r, c)).Sort sh.Range("A2")

１行目は項目行なので、２行目以降を、列「A」についてソート。

sh.Range(sh.Cells(1, 1), sh.Cells(r, c)).AutoFilter 4, "みかん"

４列目（＝列「D」）の「みかん」で、オートフィルタをかけています。

bk.SaveAs f & n & ".xlsx", 51

「xlsx」形式で保存しています。

bk.Close

閉じています。

ex.Quit

エクセルそのものを終了しています。

Set bk = Nothing
Set ex = Nothing
Set wa = Nothing
Set so = Nothing
MsgBox("Finished!")

あとは、終了処理で、最後に「Finished!」と表示しています。

お礼

回答ありがとうございます。
今からじっくり見てみます。

回答No.2

tsubu-yuki

> どのように作成すれば

とのことですから、作り方をざっと。

マクロの記録機能を動かして、
・A.csv　開く
・B.xlsx　で名前を付けて保存する
・A:J列を選択して、オートフィルタ起動
・A:J列を選択して、ソート処理
以上を記録してやり、少し手を加えてやると良いですよ。

ま、処理の順番がどうなのかと個人的には思うのですが、
開いてソートしてフィルタかけて保存、くらい手間でもないでしょう。
マクロにこだわる理由が欲しいところです。

お礼

上記のやり方は既にやっていますが、これではできないことも確認しています。