[[20140930210405]] 『テキストファイルを生成して文字列を書き込む』(ゆういち) ページの最後に飛ぶ

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

 

『テキストファイルを生成して文字列を書き込む』(ゆういち)

以前に下記の質問をさせていただき、すばらしいコードを教えていただきました。

以前の質問
http://www.excel.studio-kazu.jp/kw/20140901185038.html

今回はそのコードを少し拡張して、「文字列書き込み」を追加したいと考えています。

質問は改めて、整理して書き直しました。

どうぞ、よろしくお願い申し上げます。

.
.
.

1.新規テキスト生成
ファイル名を指定して、中身が空白の新規テキストファイルを大量に生成したいと思っています。各行のA:Zを連結したものがファイル名です。

2.文字列書き込み
そして、そのファイルに文字列を書き込みたいと考えています。

.
.
.

1.ファイル名の規則は、たとえば、画像の場合、次のようになります。

画像

A1+B1+C1+・・・・・Z1
A2+B2+C2+・・・・・Z2



A10000+B10000+C10000+・・・・・Z10000

つまり、具体的には下記のようになります。

姓名誕生日
山田太郎2976
abc&223&(あいうえお)



えお

.
.
.

2.文字列書き込み

基本的には1.と同じで、書き込む内容は「各行のAA:AZを連結したもの」が書き込む文字列です。

A1+B1+C1+・・・・・Z1という名前のテキストファイルには、
AA1+AB1+AC1+・・・・・AZ1の文字列を書き込みます。

ただし、「*TAB*」という文字列が存在した場合は半角スペースを、「*CRLF*」という文字列が存在した場合はWindowsのメモ帳で使える改行コード(CRLFでしょうか?)に、それらを置換してから連結し書き込みます。

.
.
.

他の条件は以下の通りです。

・セルの範囲は縦は1-10000、横はA-Zまでです。
・ファイルを保存するフォルダはCドライブのデスクトップにある「TXT」というの名前のフォルダとします。
・空白のセルもあまり意味はありませんが、結合する方式です。
・UTF-8です。
・拡張子はtxtです。
・A:Zがすべて空白の場合は、ファイルは生成しません。
・ファイル名が重複していることはないので、考慮する必要はありません。

よろしくお願い申し上げます。

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 Stream でファイルを開いているのですから、そこにデータを書く(Write)だけです。
http://msdn.microsoft.com/ja-jp/library/cc364272.aspx

 ファイル名を作る部分でセルの内容を連結する処理をしているので、同様に書く内容の
 文字列を作成し、連結後に Replace で TAB と CRLF を スペースと改行に置換すれば
 良いと思います。
(Mook) 2014/10/01(水) 11:29

どうもありがとうございます。

少し書き換えればよいというのはわかります。

しかし、VBAはなんとなく読めるけど、書けないという状態なので、よくわかりません。

使う前には理解してから使うようにはしておりますが、時間を取って基礎から学びなおす必要性を感じています・・・・

Forを27からのスタートに書き換えればよいのでしょうか。

また、For構文の入れ子の.writetextの""を代わりに、fnにすればよいのでしょうか。

具体的なコードはかけないので、コードを書いていただき、それに対して簡単に説明して頂ければ助かります。

お手数をおかけしますが、どうかよろしくお願い申し上げます。

        For r = 1 To UBound(tbl, 1)
            fn = tbl(r, 1)
            For c = 2 To UBound(tbl, 2)
                fn = fn & tbl(r, c)
            Next
            If fn <> "" Then
                .Open
                .writetext "", 0
                .savetofile TextFolderPath & "\" & fn & ".txt", 1
                .Close
            End If
        Next
(ゆういち) 2014/10/01(水) 16:30

 >しかし、VBAはなんとなく読めるけど、書けないという状態なので、よくわかりません。 
 そういうレベルであれば、全体のことを考えるとパンクしてしまうと思うので、
 まずは、
 (1)ファイルの中の文字列を作る
 (2)作成した文字列中の特定文字を置き換える
 (3)文字列をファイルに書く
 というように分けて考えてはどうでしょうか。

 コードを提示するのは可能ですが、今回の変更は VBA をこれから始めるという人に
 とっても良い演習レベルだと思います。
 上記のコードを書いて提示してみませんか。それぞれが 1〜5 行位のお話なので。

 自分で考えてコードを書いてみるということをしない限り、
  >なんとなく読めるけど、書けないという
 という状態からは脱却できないと思います。

(Mook) 2014/10/01(水) 17:22


丁寧にありがとうございます。

  >コードを提示するのは可能ですが、今回の変更は VBA をこれから始めるという人に
  >とっても良い演習レベルだと思います。
  >上記のコードを書いて提示してみませんか。それぞれが 1〜5 行位のお話なので。

おっしゃる通りだと思いますが、今回は期限が差し迫っているので、ゆっくり考えることはできません。すこし考えた限りではわかりませんでした。

 >自分で考えてコードを書いてみるということをしない限り、
 > >なんとなく読めるけど、書けないという
 >という状態からは脱却できないと思います。

私もそう考えています。今後VBAが必要な機会はたくさんあるので、これが終わってひと段落したら、入門書をよんで学ぼうと思っています。

お手数をおかけしますが、どうかよろしくお願い申し上げます。
(ゆういち) 2014/10/01(水) 17:57


 横から失礼します。
 回答じゃありません。
 少し考えた限り、「何が」「どのように」わからなかったのでしょう?
 置換の仕方? 「結合後」はコードのどこか?
 ご自身で改良加えるポイントは、(2)だけですので、間違ってもいいので自分で考えた答えを
 用意してほしいですね。

 ヒントというかほぼほぼ答えですが
                If fn <> "" Then
    '→
    '→
    'ここにRplaceを2連続で置いて文字を置換する
    'crlfは定数がありますので、置換後の文字をvbCrlf(""で括らない)にする
                    .Open
                    .writetext "", 0
                    .savetofile TextFolderPath & "\" & fn & ".txt", 1
                    .Close
                End If

http://officetanaka.net/excel/vba/function/replace.htm

 Replace関数の使い方はこちらを参考に。
 定数についても載っています。
( 稲葉) 2014/10/02(木) 07:33

ご指導ありがとうございます。

普段使っているのがhtmlや簡単なphpなので、文法や関数などすべてがわからないので、一度まとめて学びなおす必要があるとおもいます。

ちょっと調べただけでは私にはわかりません。

質問文にも書かせていただきましたが、ちなみにファイル名はAi〜Ziで、書き込む内容はAAi〜AZiです。(iは1以上のは行番号)

ですから、i = 27のようにあるのかなと思います。

下記に自分なりに書いてみましたが、やはりわかりません。

今回はこれ以上時間をかけられないので、次回具体的なコードをいただけない場合は、大変申し訳ありませんが、ほかのところにお願いすることにします。

お手数をおかけしますが、よろしくお願い申し上げます。

Sub Sample()

    Dim TextFolderPath
    TextFolderPath = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\TXT"

    If Dir(TextFolderPath) = "" Then MkDir TextFolderPath

    tbl = Range("A1:Z10000")
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Charset = "UTF-8"

        For r = 1 To UBound(tbl, 1)
            fn = tbl(r, 1)
            For c = 2 To UBound(tbl, 2)
                fn = fn & tbl(r, c)
            Next
            If fn <> "" Then
                .Open
                .writetext "", 0
                .savetofile TextFolderPath & "\" & fn & ".txt", 1
                .Close
            End If
        Next

        For r = 27 To UBound(tbl, 1)
            fn = tbl(r, 1)
            For c = 28 To UBound(tbl, 2)
                fn = fn & tbl(r, c)
            Next
            If fn <> "" Then

                Replace(fn, "*crlf*", vbCrlf)
                Replace(fn, "*tab*", " ")

                .Open
                .writetext "", 0
                .savetofile TextFolderPath & "\" & fn & ".txt", 1
                .Close
            End If
        Next

    End With
 End Sub

(ゆういち) 2014/10/02(木) 15:30


 コードを提示いただければ、ここが問題ですということを説明は出来ます。
 ですがご自身でその修正を厭うのであれば、他へご相談いただくか、他の方の回答を期待
 された方が良いかと思います。

 どうも、何もせずに動くコードの提供を期待されているようですので、私からのコメント
 はこれにて最後にいたします。

 とりあえずコードを提示いただいたので、気がついた点のみ下記に列挙します。
 興味なければ、読み飛ばしてください。

 現在の tbl は A1:Z10000 なので、AZ まで見るのであれば変更する必要があります。
   ⇒  tbl = Range("A1:AZ10000")

 UBound(tbl, 2) は tbl の列幅なので、それぞれのループを
            For c = 2 To 26
            For c = 28 To 52
 に変える必要があります。

 fn はファイル名のための変数なので、データ AA:AZ には別の変数を用意する必要があります。

 Replace(fn, "*crlf*", vbCrlf) ではエラーになったと思いますが、
   fn =  Replace(fn, "*crlf*", vbCrlf)
 のようにする必要があります。

 データを作る処理は、行ごとに行う必要があるので、最初の For Next の後ではなく
 For Next の中で実行する必要があります。

 全体の枠組みは下記のようになると思います。

 For r=1 To  UBound(tbl, 1)
     fn = ....
     For c=2 To 26
       fn = fn & ...
     Next

     dt = ....
     For c=28 To 52
        dt = dt & ....
     Next

    dt = Replace( ... )
    dt = Replace( ... )

    If fn <> "" Then
       .Open
       .Write dt
       .Save ...
       .Close        
    End If
 Next
(Mook) 2014/10/02(木) 16:02

ご丁寧にありがとうございます。

コードを書いていただいたほうがそちらも手間がかからないかなと思いまして・・・

下記に記しましたが、エラーになります。デバッグなどをして、気づいたのは以下の点です。

よろしければですが、再度よろしくお願い致しします。

If Dir(TextFolderPath) = "" Then MkDir TextFolderPath


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

 Sub Sample()
    Dim TextFolderPath
    TextFolderPath = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\TXT"

    If Dir(TextFolderPath) = "" Then MkDir TextFolderPath

    tbl = Range("A1:AZ10000")
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Charset = "UTF-8"

         For r=1 To  UBound(tbl, 1)
             fn = tbl(r, 1)      ’’’’’エラーの原因?
             For c=2 To 26
               fn = fn & tbl(r, c)  ’’’’’エラーの原因?
             Next

             dt = tbl(r, 1)      ’’’’’エラーの原因?
             For c=28 To 52
                dt = dt & tbl(r, c)  ’’’’’エラーの原因?
             Next

            dt = Replace(dt, "*crlf*", vbCrlf)
            dt = Replace(dt, "*tab*", " ")

            If fn <> "" Then
               .Open
               .Write dt
               .savetofile TextFolderPath & "\" & fn & ".txt", 1   ’’’’’エラーの原因?
               .Close        
            End If
         Next

    End With
 End Sub
(ゆういち) 2014/10/03(金) 19:45

 >コードを書いていただいたほうがそちらも手間がかからないかなと思いまして・・・
 別に楽をしたい(手間を惜しむ)なら、そもそも質問の回答などしませんよ。

 一生懸命がんばっている人はお手伝いしたくなりますけれど、
 人に丸投げして自分は知りません、では「・・・・」 っていうことです。

 本題に返って、
 コードへのコメントです。
 フォルダチェックは下記のようにしてください。
    If Dir(TextFolderPath ) = "" Then MkDir TextFolderPath
 は
    If Dir(TextFolderPath, vbDirectory) = "" Then MkDir TextFolderPath
 上の場合は、ファイルのチェックになりますので、フォルダがあっても検知できません。

 dt = tbl(r, 1)
 は AA 列から始めたいのですから
 dt = tbl(r, 27)
 です。数字の意味を理解してください。tbl は第一引数が行、第二引数が列です。

 .Write dt
 は
 .WriteText dt
 に変更してみてください。Write はバイナリの書き込みのようですね。

 SaveToFile の第二引数は上書きするのであれば、2 の方が良いと思います。
http://msdn.microsoft.com/ja-jp/library/cc389870.aspx

 このあたりは、エラーが出たらその部分をネット検索するなど、まずはご自身でも原因を
 考えてみてください。
(Mook) 2014/10/03(金) 20:42

完成しました。

感動です!

最後までご丁寧に、本当にありがとうございました。

また何かの機会があれば、よろしくお願いいたします。

 Sub Sample()
    Dim TextFolderPath
    TextFolderPath = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\TXT"

    If Dir(TextFolderPath, vbDirectory) = "" Then MkDir TextFolderPath

    tbl = Range("A1:AZ10000")
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Charset = "UTF-8"

         For r = 1 To UBound(tbl, 1)
             fn = tbl(r, 1)
             For c = 2 To 26
               fn = fn & tbl(r, c)
             Next

             dt = tbl(r, 27)
             For c = 28 To 52
                dt = dt & tbl(r, c)
             Next

            dt = Replace(dt, "*crlf*", vbCrLf)
            dt = Replace(dt, "*tab*", " ")

            If fn <> "" Then
               .Open
               .WriteText dt
               .SaveToFile TextFolderPath & "\" & fn & ".txt", 2
               .Close
            End If
         Next

    End With
 End Sub
(ゆういち) 2014/10/03(金) 21:29

コメント返信:

[ 一覧(最新更新順) ]


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