MS-ExcelファイルをCSV形式で保存するVBScript

bonlifeです。大量のExcelファイルをCSVにする必要が出てきたので、慣れないVBScriptを書いてみましたよ。書いた後にググッたらほぼ同じスクリプトがありました(MS-ExcelファイルをCSV形式で保存するWSHスクリプト)が、気にしないことにします!

  • カレントフォルダのExcelファイルの特定のシートをCSVに変換 (excelToCsv.vbs)
Option Explicit
' On Error Resume Next

' 変数の宣言

Dim Msg
Dim objFS
Dim objFolder
Dim objFiles
Dim objFile
Dim objExcel
Dim targetSheetNum

' CSVに変換するシートを指定

targetSheetNum = 2

' 開始処理

Msg = MsgBox("はーじめーるよー!(^o^)ノ", vbYesNo, "はーじめーるよー!(^o^)ノ")
If Msg = vbNo Then
    MsgBox "やっぱりやめるのね。。。orz", vbOkOnly, "ショックです。。。"
    WScript.Quit
End If

' カレントフォルダのExcelファイルを1つずつ処理
' Excelかどうかはファイル名が ".xls" で終わるかどうかで判断

Set objFS     = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(".")
Set objFiles  = objFolder.Files
Set objExcel  = CreateObject("Excel.Application")

For Each objFile In objFiles
    If Right(objFile.Name, 4) = ".xls" Then
        Dim fullPathFileName
        fullPathFileName = objFS.BuildPath(objFolder,objFile.Name)
        ' MsgBox fullPathFileName, vbOkOnly, "処理中のファイル"
        ExcelToCsv objExcel, fullPathFileName, targetSheetNum
    End If
Next

Set objFS    = Nothing
Set objExcel = Nothing

MsgBox "たぶん終わったよー!(^o^)ノ", vbOkOnly, "終わったよー(^o^)ノ!"

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ExcelToCSV
'  - Excelの機能を使ってExcelをCSVに変換
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub ExcelToCsv(objExcel, fullPathFileName, targetSheetNum)
    Dim xlSheet
    Dim csvFileName
    objExcel.DisplayAlerts = False
    objExcel.Workbooks.Open(fullPathFileName)
    Set xlSheet = objExcel.Worksheets(targetSheetNum)
    ' 1行目(見出し行)は削除
    xlSheet.Rows(1).Delete
    csvFileName = Left(fullPathFileName, Len(fullPathFileName) - 4) + ".csv"
    ' CSVで保存するには SaveAs の2つ目の引数で 6 を指定
    xlSheet.SaveAs csvFileName, 6
    objExcel.Workbooks.Close
End Sub

変数のスコープがよくワカラナイなぁ…。変数名の付け方が相当あやしいですが、そこはご愛嬌。後、VBScriptには例外処理みたいなのがないんですね…。「Try..Catch..Finally in ... VBScript? Sure!」で紹介されているようにClassを使えばなんとかなりそうですが、まぁ、使い捨てスクリプトなので気にしないことにします。
次からはVBScriptで書くぐらいだったらWSH(JScript)で書くことにします! (違いを理解していませんが…orz)

EXCELの日付項目のシリアル値は変

休み明けのダルさが抜けないbonlifeです。気になる記事があったので調べてみました。

EXCELとPythonの日付が一日ずれる?

そうなんです。今まで全く気付きませんでしたが、EXCELがオカシイんです。

1900年2月29日って、なんぞこれ。Pythonで扱おうとする場合、処理に一工夫必要ですね。

import datetime

def get_date_from_excel_serial(n):
    if n < 60:
        return datetime.date(1900,1,1) + datetime.timedelta(n-1)
    elif n >= 61:
        return datetime.date(1900,1,1) + datetime.timedelta(n-2)
    else:
        return None

こんな感じの関数を作っておけばOK。

In [20]: for i in range(50,70):
   ....:     print i, get_date_from_excel_serial(i)
   ....:
50 1900-02-19
51 1900-02-20
52 1900-02-21
53 1900-02-22
54 1900-02-23
55 1900-02-24
56 1900-02-25
57 1900-02-26
58 1900-02-27
59 1900-02-28
60 None
61 1900-03-01
62 1900-03-02
63 1900-03-03
64 1900-03-04
65 1900-03-05
66 1900-03-06
67 1900-03-07
68 1900-03-08
69 1900-03-09

互換性は大切ですが、Lotus 1-2-3に引きずられてこの仕様ってのもちょっとね…。

CSVの値を元に生成した文字列を返すユーザ定義関数の例

すごく忙しいわけじゃないのですが、なんとなく忙しい雰囲気に負けている今日この頃。bonlifeです。
今日は人力検索はてなEXCELに関する質問(http://q.hatena.ne.jp/1161677895)の回答を見てビックリしちゃいましたよ。4つ目のid:talepandaさんの回答が秀逸。Excelで"1,3,7,12,13"を"1010001000011"に変換したい、っていう質問なんですが、id:talepandaさんはワークシート関数を使ってシンプルなコードで見事に要望を実現。勉強になりました。なんとなくVBA中ではワークシート関数を避けていましたが、適材適所で使いこなしていきたいものです。関数を甘くみちゃいけないなぁ…。
ちなみに私が今の実力で普通に書いてみたら以下のような感じになりました。

Option Explicit
Function csvToZeroOne(csvNum As String)
    
    ' 変数の宣言
    Dim numArray, i As Long, arraySize As Long, strLen As Long, outputStr As String
    
    numArray = Split(csvNum, ",") ' 第1引数に指定された値をカンマで分割
    arraySize = UBound(numArray)  ' 分割結果の配列の大きさを取得
    '
    ' csvNum中では数値が昇順に並んでいると仮定
    ' 最後の値を最大値として取得し、出力文字列の桁数とする
    '
    strLen = numArray(arraySize)
    
    ' strLenの値を元にゼロ埋めされた文字列を生成
    For i = 0 To strLen - 1
        outputStr = outputStr + "0"
    Next i
    ' 配列に取得した数値と一致する部分を"1"に変更
    For i = 0 To arraySize
        outputStr = Left(outputStr, Trim(numArray(i)) - 1) + "1" + Mid(outputStr, Trim(numArray(i)) + 1)
        ' MsgBox (outputStr)
    Next i
    
    ' 関数の戻り値に文字列を設定
    csvToZeroOne = outputStr

End Function

なんだかあんまりですね…。Excelの関数はちゃんと勉強したことがないので、一冊ぐらい本買って読んでみようかしら。オススメがあれば教えてくださいませ。

A列の内容を分割してB、C、D列にセットする例

肌荒れがヒドイbonlifeです。スキンケアしなきゃ!今日は人力検索はてなEXCELに関する質問(http://q.hatena.ne.jp/1161146528)で「これは簡単だな。」と思って試しにVBAを書いてみたところ、思わぬ罠にハマって苦戦してしまいましたよ。忘れないうちにメモしておきます。A列の値から"-"(ハイフン)を削除した後、分割してB列、C列、D列にセットするだけのシンプルなVBAです。

Option Explicit
Sub Macro1()
    ' 前ゼロ消失防止のために文字列として扱う
    Columns("A:D").NumberFormatLocal = "@"
    ' A列の"-"(ハイフン)を削除
    Columns("A").Select
    Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells(1, 1).Select
    ' 最後の行の値を取得し、変数に格納
    Dim lastRow As Long
    lastRow = Columns("A").SpecialCells(xlLastCell).Row
    ' カウンタ用変数定義、初期化
    Dim i As Long
    i = 1
    ' 1行目から最後の行まで1行ずつ処理
    While i <= lastRow
        Cells(i, 2).Value = Left(Cells(i, 1).Value, 3)   ' 左3文字を2列目(B列)にセット
        Cells(i, 3).Value = Mid(Cells(i, 1).Value, 4, 4) ' 4文字目から4文字を3列目(C列)にセット
        Cells(i, 4).Value = Mid(Cells(i, 1).Value, 8, 4) ' 8文字目から4文字を4列目(D列)にセット
        i = i + 1
    Wend
End Sub

試してみたところ、上手くいくケースと、「あらら…」な結果になってしまうケースがありまして。なんだか置換処理を行うと先頭の前ゼロがなくなってしまう模様。例えば「042-1111-1111」という値から"-"(ハイフン)を削除するReplaceを行っただけなのに「4211111111」となってしまうのです。むむぅ。と思いながらアレコレ調べたところ、以下の仕様という名の問題に該当してしまっていることが発覚。

数値が含まれている文字列を、[置換] により、数値のみのデータに変換すると、表示形式は文字列のままですが、数値データとして 認識される場合があります。

ガビョーンですよ。これを仕様だと言い切れるMicrosoft最強説。とは言うものの、元データを破壊する置換を使った処理はそもそも適切ではないので、別のやり方にしてみました。

Option Explicit
Sub Macro1()
    ' 前ゼロ消失防止のために文字列として扱う
    Columns("A:D").NumberFormatLocal = "@"
    ' 最後の行の値を取得し、変数に格納
    Dim lastRow As Long
    lastRow = Columns("A").SpecialCells(xlLastCell).Row
    ' データクリア
    Range(Cells(1, 2), Cells(lastRow, 4)).ClearContents
    ' 変数定義
    Dim i As Long, cellValue As String
    i = 1 ' カウンタ用変数の初期化
    ' 1行目から最後の行まで1行ずつ処理
    While i <= lastRow
        cellValue = Replace(Cells(i, 1).Value, "-", "") ' 1列目(A列)の値からハイフンを削除し、変数に代入
        Cells(i, 2).Value = Left(cellValue, 3)          ' 左3文字を2列目(B列)にセット
        Cells(i, 3).Value = Mid(cellValue, 4, 4)        ' 4文字目から4文字を3列目(C列)にセット
        Cells(i, 4).Value = Mid(cellValue, 8, 4)        ' 8文字目から4文字を4列目(D列)にセット
        i = i + 1
    Wend
End Sub

こっちのReplaceは問題ナシです。分かりやすいし、確実ですね。
最後にこの件を調べていて見つけた参考になるページをご紹介。普段は気にしなくてもなんとかなりますが、知っておくと役に立つかもです。

テキストファイルをEXCELに取り込んで処理を行う例

EXCEL VBAビギナーのbonlifeです。人力検索はてなで仕事でも時折使えそうな質問(http://q.hatena.ne.jp/1151842104)が出ていたので、回答を準備してみました。
VBAでテキストファイルを指定した区切り文字で分割して取り込み、後処理を行う、という流れです。取り込むファイルに区切り文字ではない値としてのスペースが含まれていたり、括弧の対応が合っていなかったりすると上手く動きません。ポイントはOpenTextだけですね。中盤部分の後処理では泥臭い処理になってしまっています…。VBAには慣れてないのでよく分かりませんが、Line Inputステートメントを使って1行ずつ処理してからEXCELに取り込んだ方が良いのかもしれないです。まぁ、このソースでも読み込むファイルのサイズが極端に大きくなければ問題なく動作するはずですので、ご安心を。繰り返し頻度が少ない処理であれば、秀丸マクロで正規表現使ってアレコレやってタブ区切りにしたデータをEXCELに貼り付ける方が簡単だと思いました。

続きを読む

EXCELのデータをテキストに貼り付ける際に余計なダブルクォートを削除

休みの日に限って勤勉なbonlifeです。人力検索はてなの質問(http://www.hatena.ne.jp/1137168136)に適当な回答をしていたのですが、ちょっと見直してみました。セル内にAlt+Enterで入力できる改行がある場合、そのセルをコピーすると先頭行の最初と最終行の最後にダブルクォートが挿入されます。この改行を削除するための秀丸マクロを書いてみました。どういったケースで活用できるのかは、イマイチ不明ですが、EXCELで表示されている内容をそのまま秀丸に貼り付けることが出来ます。処理速度は…遅いです。表示の制御を行っていないせいもあるとは思いますが、なんとも遅いです。
http://d.hatena.ne.jp/junsub777/20060118
こちらでいくつかアイディアを出されている方がいらっしゃいますが、私のやり方は

  • 貼り付けた内容から、"を抜く
  • コピーした内容から、"を抜く

の間ぐらいでしょうか。全て貼り付けた後、処理を行う方が速いのかな、とも思ったのですが、その場合、どうやって貼り付けた範囲を覚えておいて、先頭行と最終行で処理を分けるのかが分からなかったんですよね…。仕方なく、クリップボードの内容を配列に1つずつ入れて、配列の値を取り出す際に適宜ダブルクォートを削除する実装にしてみました。もっとスマートなやり方があるかしら。

// クリップボード操作開始
beginclipboardread;

// 配列$a[]にクリップボードの内容を一行ずつ取り込み
#i=0;
$a[#i]=getclipboard;

while($a[#i]!=""){
	#i=#i+1;
	$a[#i]=getclipboard;
}

// 配列$a[]が空の場合、マクロを終了
if ($a[0]==""){
	endmacro;
}

// 配列$a[]の大きさが1の場合、そのまま貼り付け
if ($a[1]==""){
	insert $a[0];
} else {
// 配列$a[]の大きさが2以上の場合、以下の処理を実行
//   一行目の処理
//   (1) ダブルクォート2つを1つに戻す
//   (2) 行頭のダブルクォートを削除
	insert $a[0];
	up 1;
	selectline;
	replaceall "\"\"", "\"" , regular , inselect;
	selectline;
	replaceall "^\"", "" , regular , inselect;
	down 1;
//   二行目から最終行の前の行までの処理
//   (1) ダブルクォート2つを1つに戻す
	#j=1;
	while($a[#j+1]!=""){
		insert $a[#j];
		up 1;
		selectline;
		replaceall "\"\"", "\"" , regular , inselect;
		down 1;
		#j=#j+1;
	}
//   最終行の処理
//   (1) ダブルクォート2つを1つに戻す
//   (2) 行末のダブルクォートを削除
	insert $a[#j];
	up 1;
	selectline;
	replaceall "\"\"", "\"" , regular , inselect;
	selectline;
	replaceall "\"$", "" , regular , inselect;
	down 1;
}

秀丸マクロで変数を記憶するためのメモリは640KBなので、あまり大きなデータは扱えないので注意が必要です。また、クリップボード内に一行の長さが4KB以上のデータは4KBでデータが切られてしまうらしいです。秀丸マクロのヘルプには「ぶっちぎられてしまいます。」と書いてあります。すごい表現ですね…。
ちなみに、EXCELのセル内での改行を検索する場合、検索文字列を入力する部分でCtrl+Jと入力する、ということを知っているとどこかで役に立つかも。(ソースはこちらです。 : http://arena.nikkeibp.co.jp/tec/excel/20040308/107599/)

続きを読む

秀丸マクロでEXCELのPROPER関数を実装

SNYDER'Sにハマっているbonlifeです。昨夜、人力検索はてなの質問(http://www.hatena.ne.jp/1139656587)に不正確な回答をしてしまいました。まぁ、いつものことです。再回答しましたが、開かれない可能性もあるのでこちらにも書いておきます。(再回答の内容にもゴミコードが含まれてます…。ガビョーン。)EXCELでのPROPER関数、OracleでのINITCAPのような英単語の先頭を大文字、それ以外を小文字にするマクロを作成いたしました。

disabledraw;
// 全て選択し、小文字に変換
selectall;
filter "" , "ToLower";
// 単語の先頭の文字を大文字に変換
gofiletop;
while (code != eof ){
	beginsel;
	right;
	endsel;
	filter "" , "ToUpper";
	escape;
	left;
	wordright;
}
gofiletop;
enabledraw;

秀丸がVer 5.0以上の場合、変換モジュールが標準で組み込まれており、大文字への変換(ToUpper)、小文字への変換(ToLower)は簡単に実行できます。wordrightの動きと改行の関係がよくつかめておらず、最初はleftを入れておりませんでした。その結果、改行直後の単語(つまり行頭の単語)の先頭の文字が大文字になりませんでした。色々試していると改行も1つのwordとして扱われているようでしたので、leftで元の位置に戻した後、wordrightで次の単語を指定してみました。すると求める動きをするようになりました。めでたし、めでたしです。最初whileの次の行にgowordtopを入れていたのですが、wordrightした時に次の単語の先頭にカーソルが移動しており、gowordtopは全く無意味だということが分かりましたので、その部分も削除いたしました。
後はお好みに応じて選択範囲に対して処理をするように改訂をしたり、マクロ実行後のカーソルの位置を元に位置やファイルの最後に変更するなどしてみてはいかがでしょうか。それにしても秀丸マクロ、便利ですね。