マクロでデスクトップに書き出し

質問

以下のスクリプトについて教えてください。

setで代入したことろはセルの内容がしっかり反映されていたのですが、
＝になってからは、書き出されたテキストファイルに不備が出ました。
ググってみたところ、オブジェクト型（セルをまるごとなど）にはsetを使わないとダメとのことでした。

そこで、下記のスクリプトの

IntFlNo = FreeFile
Open StrFN For Output As #IntFlNo
s = Replace(Worksheets("Sheet2").Range("A171").Text, "<br />", vbCrLf)
Print #IntFlNo, s
s = Replace(Worksheets("Sheet2").Range("B171").Text, "<br />", vbCrLf)
Print #IntFlNo, s
Close #IntFlNo

の部分で、
ｓの変数を使っている箇所を
setで表現したスクリプトを教えてください。

====================================================
Sub Test()

Range("E3").CurrentRegion.Select
Selection.Replace What:="" & Chr(10) & "", Replacement:="<br />", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False

Application.Wait Now + TimeValue("00:00:01")

Dim s As String, IntFlNo As Integer
Dim StrFN As String, myObj As Object

Set myObj = CreateObject("WScript.Shell")
StrFN = myObj.SpecialFolders("Desktop")
Set myObj = Nothing
StrFN = StrFN & "\d.txt"

IntFlNo = FreeFile
Open StrFN For Output As #IntFlNo
s = Replace(Worksheets("Sheet2").Range("A171").Text, "<br />", vbCrLf)
Print #IntFlNo, s
s = Replace(Worksheets("Sheet2").Range("B171").Text, "<br />", vbCrLf)
Print #IntFlNo, s
Close #IntFlNo

End Sub

回答No.2

cj_mover · ベストアンサー

＃１、ｃｊです。補足欄へのレスです。

> Range("A171")、Range("B171")には、CONCATENATE、char10()、など色々なセルの値がミックスされた
> データが入っております。

これは、＃１で私が指摘したセル参照の間違いは、ない、ということだと思います。

> 一応この記述で実行すると、Range("A171")、Range("B171")の順番でテキストファイルに出力されます。

これは、アクセスモード[Output]のままで、構わない、ということだと思います。

> ＝を使った理由は、<br />を改行に置換したかったからです。

これは、現状の問題点は、「<br />を改行に置換できない」という一点に絞られている、ということだと思います。

> もし、setを使って改行に置換できるのであれば、
> 以下の構文を使って、<br />を改行に置換できる方法を教えていただきたいです。

ご提示のマクロは何れも、
セル範囲のデータ（文字列値）を元に、
文字列（整形）処理「<br />を改行に置換」をした文字列データを
テキストファイルに出力する、
という内容なっています。

そちらで、多少の誤解があるように思いますが、
当初のご質問本文にて提示されたコードの中で、
　　s = Replace(Worksheets("Sheet2").Range("A171").Text, "<br />", vbCrLf)
　　s = Replace(Worksheets("Sheet2").Range("B171").Text, "<br />", vbCrLf)
これら２箇所の記述によって、"<br />" は、vbCrLf に正しく置換されて
文字列型変数に格納されています。
また、実際に出力されたテキストファイルの内容についても、
正しく置換されていることを確認した上で回答に至っています。
「<br />を改行に置換できない」という点が、まず、理解しづらいのです。

次に、扱うデータは文字列型ですから、
　　通常、オブジェクト型変数にオブイジェクトアクセスを設定する為に使う
Set ステートメントを使う必要性は全くありません。
なので、
> setを使って改行
というお望みには答えようがないのです。
強いて応えるなら、以下のような感じでしょうか？
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub ReMacro25()
　　Range("E3").CurrentRegion.Select
　　Selection.Replace What:="" & Chr(10) & "", Replacement:="<br />", LookAt:=xlPart, _
　　SearchOrder:=xlByRows, MatchCase:=False

　　Application.Wait Now + TimeValue("00:00:01")

　　Dim myObj As Object
　　Dim ranData As Range
　　Dim StrFN As String
　　Dim s As String
　　Dim IntFlNo As Integer

　　Set myObj = CreateObject("WScript.Shell")
　　StrFN = myObj.SpecialFolders("Desktop")
　　Set myObj = Nothing
　　StrFN = StrFN & "\d.txt"

　　Set ranData = Worksheets("Sheet2").Range("A171")
　　s = ranData.Value
　　Set ranData = Worksheets("Sheet2").Range("B171")
　　s = s & vbCrLf & ranData.Value
　　Set ranData = Nothing
　　s = Replace(s, "<br />", vbCrLf)

　　IntFlNo = FreeFile
　　Open StrFN For Output As #IntFlNo
　　Print #IntFlNo, ranData.Value
　　Close #IntFlNo

End Sub
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
勿論、これも動作確認済ですが、処理の内容には変わりありません。
Set ステートメントと文字列の置換には関係ないからです。

ただ、
「<br />をvbCrLfに置換」出来ていても
例えば
「<br/>をvbCrLfに置換」するようには書けていませんから、
この半角スペースひとつの違いであっても
　　s = Replace(s, "<br/>", vbCrLf)
と、追記する必要が出てくる場合もあるでしょう。

或いは、
「<br />と<br/>を同時にvbCrLfに置換」したい、
ということでしたらば、それは、
正規表現（RegExp）オブジェクトを用いて実現することになりますが、
今回のご質問では、そこまではお求めでないと考えています。

ご提示のマクロの冒頭４行が、処理にどのように関連しているか、最初は判らなかったのですが、
Worksheets("Sheet2").Range("A171")またはWorksheets("Sheet2").Range("B171")のセルに設定された数式が
Range("E3").CurrentRegionのセルを参照していて、
Range("E3").CurrentRegionにて「Chr(10)つまりvbLf を　"<br />"　に置換」した結果を
Worksheets("Sheet2").Range("A171")またはWorksheets("Sheet2").Range("B171")のセルに設定された数式にも
反映させたい、ということでしょうか。
それでしたら、
Application.Wait Now + TimeValue("00:00:01")
の代りに
Worksheets("Sheet2").Range("A171:B171").Calculate
と記述すれば、
処理の確度を高めることができます。

もうひとつの可能性として、
Worksheets("Sheet2").Range("A171")またはWorksheets("Sheet2").Range("B171")のセルに設定された数式の中に
CHAR(10)が使われているのであれば、これが、思わぬ結果の原因である可能性は高いです。
改行文字を統一しなければ、正しく出力されないことはありますので。
その場合は。改行を一旦、vbLf（CHAR(10)） に統一しておいてから、最後に vbCrLf に統一するようにします。

それと、これは求められてもいない余計なことかも知れませんが、
参照先のセル値にの一部に、<br />に続けてセル内改行（CHAR(10)）が並んでいる場合、
普通は、これをひとつの改行と看做す必要があります。
これらのポイントを踏まえて当初ご提示のコードを書き換えると以下のようになります。
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub Test9()
　　' ' 冒頭４行不要
　　Dim s As String, IntFlNo As Integer
　　Dim StrFN As String, myObj As Object

　　Set myObj = CreateObject("WScript.Shell")
　　StrFN = myObj.SpecialFolders("Desktop")
　　Set myObj = Nothing
　　StrFN = StrFN & "\d.txt"

　　IntFlNo = FreeFile
　　Open StrFN For Output As #IntFlNo
　　s = Replace(Worksheets("Sheet2").Range("A171").Text, "<br />" & vbLf, vbLf)
　　s = Replace(s, "<br />", vbLf)
　　s = Replace(s, vbLf, vbCrLf)
　　Print #IntFlNo, s
　　s = Replace(Worksheets("Sheet2").Range("B171").Text, "<br />" & vbLf, vbLf)
　　s = Replace(s, "<br />", vbLf)
　　s = Replace(s, vbLf, vbCrLf)
　　Print #IntFlNo, s
　　Close #IntFlNo
End Sub
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
繰り返しになりますが、こちらでは実際にサンプルを複数作成して、
動作を確認しています。
元のコードから一部、文字列の置換処理を書き換えた程度ですが、
どうでしょう、改行は正しく反映されていませんか？
大変でしょうけれど、検証、頑張ってください。

お礼

ありがとうございます。
本当に詳しく教えていただき、心から御礼申し上げます。

上の方の式で検証してみましたところ、
下から３行目のPrint #IntFlNo, ranData.Valueでエラーがでたたえめ、
Print #IntFlNo, s　に書き換えました。

そうしたらテキストファイルでしっかり改行されたものが出力されました！
以前は途中でデータが途切れたりしていたので、
これで安心して業務に取り掛かれます。

この度は本当にありがとうございました。

Range("E3").CurrentRegion.Select
Selection.Replace What:="" & Chr(10) & "", Replacement:="<br />", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False

Application.Wait Now + TimeValue("00:00:01")

Dim myObj As Object
Dim ranData As Range
Dim StrFN As String
Dim s As String
Dim IntFlNo As Integer

Set myObj = CreateObject("WScript.Shell")
StrFN = myObj.SpecialFolders("Desktop")
Set myObj = Nothing
StrFN = StrFN & "\d.txt"

Set ranData = Worksheets("Sheet2").Range("A171")
s = ranData.Value
Set ranData = Worksheets("Sheet2").Range("B171")
s = s & vbCrLf & ranData.Value
Set ranData = Nothing
s = Replace(s, "<br />", vbCrLf)

IntFlNo = FreeFile
Open StrFN For Output As #IntFlNo
Print #IntFlNo, s
Close #IntFlNo

回答No.3

cj_mover

＃１、２、ｃｊです。
失礼しました。色々書いている内に、掲載するべきものを選択ミスしてしまったようです。
ご指摘の通り、
　　Print #IntFlNo, ranData.Value
は、誤りで、
　　Print #IntFlNo, s
が、実際にテストしていた内容で、こちらが意図したものです。
すみません。

回答No.1

cj_mover

こんにちは。

結論から言うと、ご提示のコードに文法上の誤りはありません。
> ｓの変数を使っている箇所を
> setで表現したスクリプトを教えてください。
と仰っている部分では、Object型やオブジェクトを扱う変数などは
扱われていませんので、set　は使いようがありません。
ご提示のコードでオブジェクト型というと、
myObj As Object が唯一該当しますが、
この変数とオブジェクトの扱いにもまったく問題ありません。

> 書き出されたテキストファイルに不備が出ました。
残る問題は、
「何がしたくて」
「求める結果」
と「どう違うか」
ということになると思います。
まずは、この点を、ご自身で言葉にして整理することから始めてみてください。

ご提示のコードについては、
その目的や条件によっては、間違いのない正しい記述なのです。

差し当たり、ありがちな例を挙げておくと、
「テキストの追加書き出しをしたい」
なのに、
「出力済のテキストの次に追加出力される」
つもりが
「上書きされてしまって以前に保存したテキストが消えてしまう」
というようなことでしたらば、
　Open StrFN For Output As #IntFlNo
のアクセスモード[Output]が不適切です。
もし、そういうことでしたらば、
アクセスモード[Append]について調べて、
追加書き出しが出来るようにすれば解決すると思います。
特に解説は添えませんが質問者さんなら、できると思います。

他に、どんな問題があるか、想像ですが、
出力の前処理としてのテキストの整形がうまくいっていないのかもしれません。
これについては、
プロシージャの実行をF8キー（ステップイン）で一行ずつ、
イミディエイトウィンドウに
? s
とタイプしてそのままEnterすれば、文字列型変数 s の内容が確認できますから、
どこに間違いがあるか探してみてください。

Excel VBA に不慣れで、Excel には慣れ切っている人にありがちなミスとして、
.Range("A171")
のような記述が、適切な参照になっているのか、一応、確認してみてください。
例えば、
Excel数式では、「=C3」という数式を設定した後で、
２行めを削除した場合は「=C2」
Ｂ列を削除した場合は「=B3」
のように自動的に参照先を書き換えてくれる機能が備わっていますが、
ＶＢＡには、そのようなお節介な機能はありません。
手動であれＶＢＡの処理によるものであれ、セル範囲の削除をするようであれば、
それに合わせて書き方を替えていかないとなりません。

とりあえず、確率の高そうな点に限り指摘してみました。
これ以外のケースについては、そちらで情報を整理してから
補足欄にでも書いてみてください。

補足

Range("A171")、Range("B171")には、CONCATENATE、char10()、など色々なセルの値がミックスされた
データが入っております。

一応この記述で実行すると、Range("A171")、Range("B171")の順番でテキストファイルに出力されます。

＝を使った理由は、<br />を改行に置換したかったからです。

もし、setを使って改行に置換できるのであれば、
以下の構文を使って、<br />を改行に置換できる方法を教えていただきたいです。

====================================================
Sub Macro25()

Range("E3").CurrentRegion.Select
Selection.Replace What:="" & Chr(10) & "", Replacement:="<br />", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False

Application.Wait Now + TimeValue("00:00:01")

Dim ranData As Range, IntFlNo As Integer
Dim StrFN As String, myObj As Object

Set myObj = CreateObject("WScript.Shell")
StrFN = myObj.SpecialFolders("Desktop")
Set myObj = Nothing
StrFN = StrFN & "\d.txt"

Set ranData = Worksheets("Sheet2").Range("A171")

IntFlNo = FreeFile
Open StrFN For Output As #IntFlNo
Print #IntFlNo, ranData.Value

Set ranData = Worksheets("Sheet2").Range("B171")
Print #IntFlNo, ranData.Value

Close #IntFlNo

End Sub
====================================================