[[20150928195707]] 『単純な置換と挿入』(まさみ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『単純な置換と挿入』(まさみ)

このスレに似たマクロです。

『改行コードがあればpタグを挿入する、テキストフメx(まさみ) エクセル Excel [エクセルの学校]
http://www.excel.studio-kazu.jp/kw/20150922113921.html
.
.
.
前のスレと比べると、かなり単純だと思います。

・複数ファイルの一括処理
・ファイルを直接上書きで処理
・文字コードがSHIFT_JIS
・改行コードがCRLF

など、基本的な仕様はすべて同じです。
.
.
.

処理内容は、

・改行コード「 CRLF 」を「 <br /> + CRLF 」にすべて置換する。

・ファイルの一番最初に「 <p> + CRLF 」を1つ挿入し、ファイルの一番最後に「 CRLF + </p> 」を1つ挿入する。
.
.
.

以下図解になります。

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

処理前
==============================================================
あいうえお。
かきくけこ。

さしすせそ。


たちつてと。



なにぬねの。




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

処理後
==============================================================
<p>
あいうえお<br />
かきくけこ<br />
<br />
さしすせそ<br />
<br />
<br />
たちつてと<br />
<br />
<br />
<br />
なにぬねの<br />
<br />
<br />
<br />
<br />
</p>
==============================================================

< 使用 Excel:Excel2013、使用 OS:Windows 10 >


.
.
.
追伸

丸(。)は改行コードを表します。
.
.
.
(まさみ) 2015/09/28(月) 20:00


改行を置換ということは最終的にテキストエディタでは
<p>あいうえお<br />かきくけこ<br /><br />さしすせそ<br /><br /><br />たちつてと<br /><br />
と1行に表記されるということでいいのですか?

処理後を見ると改行した状態ということで改行コードは残ると受け取れます。
(デイト) 2015/09/29(火) 09:15


 方法は2つでしょうね。

 1つは、seiyaさんのコードであれ、私のコードであれ、最終的に
 
<p class="1">あいうえお</p>。 
<p class="2">かきくけこ</p>。 
 。 
<p class="3">さしすせそ</p>。 
 。 
 。 
<p class="4">たちつてと</p>。 
 。 
 。 
 。 
<p class="5">なにぬねの</p>。 
 。 
 。 
 。 
 。 

 こんな形の文字列ができますので、できあがったものを

 <p class="○"> を削除。</p> を削除。 。(改行コード) を <br /> に変換。

 でも、これだと、いかにも無駄な処理になりますから

 2つめには、最初から今回の変換にする。こちらが妥当でしょうね。

 抜出は、seiyaさんのコードでも私のコードでも、正規表現を使っていますが、そこは変更不要で
 抜き出した後の文字列を作り上げるところ、ここは、通常のコードで書かれていますので、
 ここを、新しい文字列の組み立てに合わせて微修正すればよろしいかと。

 そんなに難しいところではないので、自分でできるのではと思いますが、お手伝い必要なら対応します。

(β) 2015/09/29(火) 09:33


 ↑で1つの方法をコメントしましたが、「単純な置換と挿入」といっておられるとおり
 正規表現を持ち出すまでもなく、以下のような単純変換で可能でしょうかね。

 Sub Sample2()
    Dim ncl As String
    Dim s As String
    Dim fso As Object
    Dim myTxt As Object
    Dim fPath As String

    ncl = vbCrLf        '対象改行コード

    Set fso = CreateObject("Scripting.FileSystemObject")

    fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\テキスト"   '★

    For Each myTxt In fso.GetFolder(fPath).Files
        If LCase(fso.GetExtensionName(myTxt.Name)) = "txt" Then
            s = myTxt.OpenAsTextStream.ReadAll
            myTxt.OpenAsTextStream.Close
            s = Replace(s, ncl, "<br />")
            'ファイル書き換え
            With fso.OpenTextFile(fPath & "\" & myTxt.Name, IOMode:=2)
                .Write "<p>" & s & "</p>"
                .Close
            End With
        End If
    Next

 End Sub

(β) 2015/09/29(火) 10:32


ありがとうございます。
.
.
.
デイト様

>処理後を見ると改行した状態ということで改行コードは残ると受け取れます。

おっっしゃる通りです。質問のほうを、上書きで編集して、訂正しておきました。

よろしくおねがいします。
.
.
.
β様

エラーになってしまいました。

ttp://www.fastpic.jp/viewer.php?file=1535326288.png

ttp://www.fastpic.jp/viewer.php?file=6827630734.png

>そんなに難しいところではないので、自分でできるのではと思いますが、お手伝い必要なら対応します。

JavascriptやVBAを眺めたことはありますが、プログラムはほとんど書けないので、自分にとっては大変困難なことです。

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

(まさみ) 2015/09/29(火) 11:24


 >>エラーになってしまいました。 

 今までにも何度かコメントしましたけど、

 ・どんなエラー?(番号、およびメッセージ)
 ・どのコードでエラー?

 これを教えてもらわなければ手も足も出ません。
 少なくとも、こちらの環境で、稼働確認して、結果もみたうえでアップしていますので。

 ★あぁ、エラーは .Write "<p>" & s & "</p>" でしたか。
  なんというエラーでしたか?(こちらではエラーはでていません)
 ★エラーコードもありましたね。
  (掲示板上でリンクがばけていたのでクリックしませんでしたが、クリックしてわかりました)

 不思議ですねぇ。こちらではエラーになっていないので。
 ちょっと調べてみます。xl2013 でいいのですよね。

 ●ところで処理後の文字列に改行コードは残るのですか??
  私がアップしたコードは、改行コードはすべて "<br /> に置きかわり、処理後の文字列内には残りません。

(β) 2015/09/29(火) 18:13


 こういうこと?

 Sub test()
    Dim myDir As String, fn As String, txt As String, ff As Long
    myDir = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\テキスト\"
    With CreateObject("VBScript.RegExp")
        .Global = True: .MultiLine = True
        .Pattern = "(\r\n)"
        fn = Dir(myDir & "*.txt")
        Do While fn <> ""
            txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(myDir & fn).ReadAll
            txt = "<p>" & vbCrLf & .Replace(txt, "<br />$1") & "</p>"
            ff = FreeFile
            Open myDir & fn For Output As #ff
                Print #ff, txt
            Close #ff
            fn = Dir
        Loop
    End With
End Sub
(seiya) 2015/09/29(火) 18:56

β様

エラーになったのは、UTF-8のファイルを処理していたからで、SHIFT_JISでやったところ、大丈夫でした。

大変申し訳ありません。

ただし、デイト様のご指摘頂いたとおりに、質問文を変更して、仕様を変更というか訂正していますので、そのような処理でお願いいたします。
.
.
.
seiya様

一発で完璧に動作しました。今回も、的確なレスをありがとうございます。
.
.
.
(まさみ) 2015/09/30(水) 13:55


 s = Replace(s, ncl, "<br />")     --> s = Replace(s, ncl, "<br />" & ncl)

 .Write "<p>" & s & "</p>"     --> .Write "<p>" ncl & & s & ncl & "</p>" 

 >>プログラムはほとんど書けないので、自分にとっては大変困難なことです。

 このあたりは、文字列連結の基本的というか初歩的なところですので、seiyaさんからいただいたコードもあわせ
 是非、今後のためにも、理解して、これぐらいの微修正はできるようにしておかれたらよろしいですよ。

(β) 2015/09/30(水) 15:02


β様、ありがとうございます。

またエラーになってしまいましたが、いただいた情報をもとに、以下のように、自分で何となく書き換えてみたら、うまくいきました。

しばらくは忙しくてできませんが、時間があればVBAを学びたいと思っております。

これでこのスレは終了にします。
.
.
.
どうもありがとうございました。
.
.
.
エラー
.Write "<p>" ncl & & s & ncl & "</p>" --> .Write "<p>" & s & "</p>"

エラー
.Write "<p>" & s & "</p>"     --> .Write "<p>" ncl & & s & ncl & "</p>"

OK?
.Write "<p>" & ncl & s & ncl & "</p>"

 Sub Sample2()
    Dim ncl As String
    Dim s As String
    Dim fso As Object
    Dim myTxt As Object
    Dim fPath As String

    ncl = vbCrLf        '対象改行コード

    Set fso = CreateObject("Scripting.FileSystemObject")

    fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\テキスト"   '★

    For Each myTxt In fso.GetFolder(fPath).Files
        If LCase(fso.GetExtensionName(myTxt.Name)) = "txt" Then
            s = myTxt.OpenAsTextStream.ReadAll
            myTxt.OpenAsTextStream.Close
            s = Replace(s, ncl, "<br />" & ncl)
            'ファイル書き換え
            With fso.OpenTextFile(fPath & "\" & myTxt.Name, IOMode:=2)
                .Write "<p>" & ncl & s & ncl & "</p>"
                .Close
            End With
        End If
    Next

 End Sub
.
.
.
(まさみ) 2015/09/30(水) 18:00

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.