エクセルVBAについて質問です。

Dドライブ内にあるXXというフォルダの中(D:\XX)にある
全てのファイルに記入されている改行マーク(↑)を
「vbCrLf」に置換するというマクロを作ってください。

具体的にはXXフォルダ内にある全てのファイルで
下記のページにある動作を行うマクロを作ってください。
http://q.hatena.ne.jp/1162632248
その際、↑↑と連続している場合も考慮に入れて、
作成していただくようお願いします。

回答の条件
  • URL必須
  • 1人5回まで
  • 登録:2006/11/05 03:27:12
  • 終了:2006/11/07 04:01:36

回答(2件)

id:llusall No.1

llusall回答回数505ベストアンサー獲得回数612006/11/05 10:32:20

ポイント150pt

以下のVBScriptを使用してはいかがでしょうか?

使用方法

以下のソースの■部分を適宜修正して、

「一括置換.vbs」などのファイル名でデスクトップ等に保存します。

アイコンをダブルクリックすると実行されます。

Option Explicit

Dim REP_STR_BEFORE

Dim REP_STR_AFTER

Const TARGET_FOLDER = "D:\XX"    '■置換するファイルが入っている場所を指定します。

Const RESULT_FOLDER = "D:\XX2"    '■置換したファイルを入れる場所を指定します。

REP_STR_BEFORE = vbCrLf     '■置換前の文字列を指定します。(この場合「改行」)

REP_STR_AFTER  = "↓"       '■置換後の文字列を指定します。(この場合「↓」文字)

Call RepMain()

Sub RepMain()

    Dim sFname

    Dim objFS, objTXT, objTXT2, sText

    Dim objFile,objFolder

    Err.Clear

    Set objFS   = CreateObject("Scripting.FileSystemObject")

    If objFS.FolderExists(RESULT_FOLDER) Then

    Else

        objFS.CreateFolder (RESULT_FOLDER)

    End If

    Set objFolder = objFS.GetFolder(TARGET_FOLDER)

    'ファイル数の処理を実行

    For Each objFile In objFolder.Files

        sFname = objFile.Name

        Set objTXT  = objFS.OpenTextFile( TARGET_FOLDER & "\" & sFname, 1, False )

        Set objTXT2 = objFS.CreateTextFile( RESULT_FOLDER & "\" & sFname, True )

        sText = Replace(objTXT.ReadAll,REP_STR_BEFORE,REP_STR_AFTER)

        objTXT2.WriteLine(sText)

        objTXT.Close

        Set objTXT  = Nothing

        objTXT2.Close

        Set objTXT2 = Nothing

    Next

    Set objFolder = Nothing

    MsgBox "終わり。", vbInformation

End Sub

エクセルのマクロとして使用したい場合は、標準モジュールに記述し、

以下のように修正すれば良いかと思います。

'コメントにします

'Call RepMain()

'パブリックにします

Public Sub RepMain()

id:taroemon

ご回答ありがとうございます。

すごく良いアイデアですね。

こういう方法があるのを知りませんでした。

とても勉強になりました。

ところで2つ質問があります。

まず実行すると、

エラー:「終了していない文字列型の定数です」

コード:800A04009

ソース:VBScriptコンパイルエラー

とひょうじされてエラーが出ます。

どうしたらよいのでしょうか?

エクセルのマクロとして使用した場合、

どの部分を上記のように設定すれば良いのでしょうか?

以上よろしくご回答ください。

2006/11/05 22:53:06
id:llusall No.2

llusall回答回数505ベストアンサー獲得回数612006/11/06 08:05:41

ポイント35pt

再回答すみません。

エクセルマクロで使用するのであれば、次のようにしてください。

なお、VBScriptで実行した場合、コメントのエラーは確認できませんでした。

また、エラーが表示されるようであれば、コメントください。

(行番号も出ればそれも教えてください。この質問・回答へのコメントも有効にしていただけると良いかと思います。)

Option Explicit

    

Const TARGET_FOLDER = "D:\XX"    '■置換するファイルが入っている場所を指定します。

Const RESULT_FOLDER = "D:\XX2"    '■置換したファイルを入れる場所を指定します。

Public Sub RepMain()

    Dim sFname

    Dim objFS, objTXT, objTXT2, sText

    Dim objFile, objFolder

    Dim REP_STR_BEFORE

    Dim REP_STR_AFTER

    REP_STR_BEFORE = vbCrLf     '■置換前の文字列を指定します。(この場合「改行」)

    REP_STR_AFTER = "↓"        '■置換後の文字列を指定します。(この場合「↓」文字)

    Err.Clear

    

    Set objFS = CreateObject("Scripting.FileSystemObject")

    If objFS.FolderExists(RESULT_FOLDER) Then

    Else

        objFS.CreateFolder (RESULT_FOLDER)

    End If

    

    Set objFolder = objFS.GetFolder(TARGET_FOLDER)

    

    'ファイル数の処理を実行

    For Each objFile In objFolder.Files

        sFname = objFile.Name

        Set objTXT = objFS.OpenTextFile(TARGET_FOLDER & "\" & sFname, 1, False)

        Set objTXT2 = objFS.CreateTextFile(RESULT_FOLDER & "\" & sFname, True)

        sText = Replace(objTXT.ReadAll, REP_STR_BEFORE, REP_STR_AFTER)

        objTXT2.WriteLine (sText)

        objTXT.Close

        Set objTXT = Nothing

        objTXT2.Close

        Set objTXT2 = Nothing

    Next

    Set objFolder = Nothing

    MsgBox "終わり。", vbInformation

End Sub

id:taroemon

再びのご回答ありがとうございます。

とても助かります。

VBScriptを実行すると

エラーには行14、文字20と出ます。

ちなみにエクセルマクロでは実行できましたが、

このVBScriptを非常に気に入ってますので、

どうしたらよいかご回答いただけれるととても嬉しいです。

私はメモ帳にいただいたスクリプトをコピペして、

「一括置換.vbs」という名前で保存しましたが、

これがいけなかったのでしょうか?

質問中にコメントが書けるように設定しましたが、

再回答に対してもポイントをお支払いするのは

当然のことと考えています。

私としましてはわからないことだらけですので、

最後まで教えていただけることの方が重要です。

同一人物の回答も5回まで受け付けるよう設定しましたので、

何度でもコチラにご回答いただければ幸いです。

以上、よろしくお願いします。

2006/11/06 16:16:13
  • id:llusall
    ポイント送信で、ソースを送ってみました。
    試してみてください。
  • id:taroemon
    ポイント送信からソースを受け取りました。

    今度はエラーは出ませんでしたが、何もおこりません。
    つまり実行しても、XX2フォルダの中にはなにもありません。
    XX1フォルダの中のファイルの文字列を変えてみたり、
    いろいろしてみましたが、結局何も起こりませんでした。

    マクロとしては動いているようです。
    というのもいただいたソースをコピペした時、
    End subを入れるのを忘れていて、そのエラーはでたからです。

    何か思い当たることはありますか?
    もしありましたらコメントなどでお答えいただければ、
    それに対してポイントを差し上げます。

    ただ、そちらの環境でうまくいっているとなると、
    ソースの問題ではないのかもしれませんね。

    エクセルで実行する方はちゃんと動きましたし、
    こういう方法があると言うことを知り、
    今回の質問に対する回答としてとても満足しています。
    ありがとうございました。
  • id:llusall
    たくさんのポイントありがとうございました。
    (恐縮です^^)

    いくつか教えてください。

    >結局何も起こりませんでした。
    との事ですが、「終わり。」というメッセージは表示されましたか?
    処理が完了すると、メッセージを表示するようになっています。
    表示されない場合は、どこかでエラーになっていると思われます。

    TARGET_FOLDER の指定は正しいですか?(私のソースでは、
    「D:\XX1」でなく「D:\XX」になっていることに注意)
    RESULT_FOLDER の指定は正しいですか?

    上記2つのフォルダは、任意に設定していただいて結構です。
    RESULT_FOLDERのフォルダは、存在しなければ、プログラムで作成されます。

    以上、確認してみてもらえますか?
  • id:taroemon
    コメントありがとうございます。

    「終わり」はエクセルの方は出ますが、
    スクリプトの方は出ませんでした。
    ということはちゃんと動いていないということですね。

    XX1というのはコメントの方が間違いで、
    ちゃんとXXフォルダになっています。
    XX2フォルダの存在も間違いないと思います。

    いただいたスクリプトの出来がとても良く、
    個人的には気に入っていたので、
    使えなかったのは残念ですが、
    llusallさんには、現段階で考えうる
    最善の対応をしていただいたと思っています。

    また何か思い当たる節がありましたら
    連絡いただきたいと思いますが、
    そちらの環境でちゃんと動いている以上、
    これ以上は難しいかもしれませんね。

    これからも質問しますので、またいろいろ教えてください。
  • id:llusall
    もう一度、修正したソースを送信してみました。
    お手数ですが、実行してみてもらえますでしょうか?

    何度もすみません。
  • id:taroemon
    ちゃんとできました。
    さすがですね。
    最後までおつきあいいただきありがとうございました。
  • id:llusall
    ホッとしました。
    また、ポイントありがとございました。
    ありがたく頂戴させていただきます。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません