[[20121210210524]]　『テキストファイル出力』（ちー）　ページの最後に飛ぶ

『テキストファイル出力』（ちー）

現在VBA勉強中の初心者です。
仕事でVBAを使用することとなりましたが、難しく悩んでいます。
お助け頂けますと幸いです。

やりたい事は、
下記のようなエクセルのデータをボタン一つでテキストファイルへ出力出来るようにしたいです。

エクセル

   A   B 　 C   D  　 E 
1__________________________
2__________________________
3 _2_|_4__|_2_|_4___|_3_|  ←桁数
4 _1_|_1__|_2_|_1___|_2_|　←1なら文字、2なら数字
5 ___|____|________________
6 K  |R23 | 1 |AAAA | 3 |　←ここから下がデータ。
7 G* |E12D| 4 |HH*  | 05|　　　スペースは*で表記

上記のような表がありまして、
1、2、5行目はVBAボタンを設置したり、項目などに使用します。
3行目には、データの桁数が記載されています。
4行目には仮ですが、1なら文字、2なら数字というようにテキスト出力時に使用する判別のキーを入れようと思っています。
データは6行目以下でデータのある行と列の範囲は都度変わります。

①エクセルのシート上にあるBVAボタンを起動すると新規テキストファイルを作成して6行目以下のデータを全て出力出来るようにしたい。

②データはA列から右列全てをつなげて出力したいのですが、データにはスペースも入っていますのでスペースもきちんと出力したいです。
さらに、３行目に各セルに入っている桁数を記載しているのですが、セルの中にはその桁数に満たないものもあります。

例．A6セルは「K」の1文字しか入っていませんが、本当は2桁入る予定。
その満たなかった1文字を4行目に入っているキーで判断。
キーが1なら文字としてスペースを後ろに付け加えて2桁にする。
もしキーが2なら数字としてゼロ0を前に加えて桁数を揃えてから出力したいです。
ちなみに、キーとする文字は数字ではなく、Cなどのアルファベットになる可能性もあるので変更可能なようであれば助かります。

上記で出力すると下記イメージです。

テキストファイル完成

K*R23*01AAAA003
G*E12D04HH**005

ちなみに、4行目のキーが数字の2であっても、セルに入っているデータが数字のものだとは必ずしもなく、4を文字列で04と表記している場合もあります。
桁数をスペースと0で補って出力が出来ればと調べていたのですが、難しく・・。

数字の補いは、Textを使用すればなんとか出来そうだったのですが、全ての列や行をみていく方法などがよくわからず。
またスペースの補いもわかりませんでした。

テキスト出力もネットで探してみたものは、カンマ区切りの出力など。

また、上記の作業を行いながら一気にテキスト出力、というものは難しそうでしたので上記のようなデータを一旦エクセル上の別シートに作成してそこからテキスト出力しようかとも思ったのですが、セルを桁数を補いながらつなげるコードも書けませんでした・・。

どなたか助けていただけますと助かります。
どうぞよろしくお願い致します。

 >ちなみに、キーとする文字は数字ではなく、Cなどのアルファベットになる可能性もあるので変更可能なようであれば助かります。

 これは４行目のことだね？
 で、仮に、そこに C と入っていれば、どうしたい？
 メッセージを出して、正しい桁数をいれさせる？

 (ぶらっと)

 C というところがわからないので、とりあえず、アップされたルールのとおりだとして。
 列数を 5(A～E)に固定しているけど、ここは、動的に最終列を判断することもできる。
 直接、テクストファイルを作ることもできるけど、わかりやすいように、以下ではテキストファイルイメージを新規ブックで生成して
 それをマクロブックと同じフォルダに保存している。

 Sub Sample()
    Dim keyV As Variant
    Dim w As Variant
    Dim z As Long
    Dim i As Long
    Dim j As Long
    Dim n As Long
    Dim k As Variant
    Dim v() As String
    Dim wb As Workbook
    Dim sv As Long

    With Sheets("Sheet1")
        keyV = .Range("A3:E4").Value
        z = .UsedRange.Rows.Count + .UsedRange.Row - 1 'データ最終行番号
        ReDim v(1 To z - 5, 1 To 1)        'データ数分の配列

        For i = 6 To z

            w = WorksheetFunction.Index(Range("A" & i).Resize(, 5).Value, 1, 0)
            For j = 1 To 5
                n = keyV(1, j)
                k = keyV(2, j)
                If k = 2 Then '数字
                    w(j) = Format(w(j), WorksheetFunction.Rept("0", n))
                Else
                    w(j) = Left(w(j) & WorksheetFunction.Rept(" ", n), n)
                End If
            Next
            v(i - 5, 1) = Join(w, "")
        Next
    End With

    sv = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Set wb = Workbooks.Add
    Application.SheetsInNewWorkbook = sv

    wb.Sheets(1).Range("A1").Resize(UBound(v, 1)).Value = v
    Application.DisplayAlerts = False
    wb.SaveAs Filename:=ThisWorkbook.Path & "\テキストファイル名.txt", FileFormat:=xlText
    wb.Close False
    Application.DisplayAlerts = True

 End Sub

 (ぶらっと)

 直接テキストファイルに書き込む案。

 Sub Sample2()
    Dim keyV As Variant
    Dim w As Variant
    Dim z As Long
    Dim i As Long
    Dim j As Long
    Dim n As Long
    Dim k As Variant
    Dim v() As String
    Dim wb As Workbook
    Dim sv As Long

    With Sheets("Sheet1")
        keyV = .Range("A3:E4").Value
        z = .UsedRange.Rows.Count + .UsedRange.Row - 1 'データ最終行番号
        ReDim v(1 To z - 5)        'データ数分の配列

        For i = 6 To z

            w = WorksheetFunction.Index(Range("A" & i).Resize(, 5).Value, 1, 0)
            For j = 1 To 5
                n = keyV(1, j)
                k = keyV(2, j)
                If k = 2 Then '数字
                    w(j) = Format(w(j), WorksheetFunction.Rept("0", n))
                Else
                    w(j) = Left(w(j) & WorksheetFunction.Rept(" ", n), n)
                End If
            Next
            v(i - 5) = Join(w, "")
        Next
    End With

    With CreateObject("Scripting.FileSystemObject").CreateTextFile(Filename:=ThisWorkbook.Path & "\テキストファイル名.txt", OverWrite:=True)
        .write Join(v, vbCrLf)
        .Close
    End With

 End Sub

 (ぶらっと)

(ぶらっと)様

お返事ありがとうございました。
また、コードもご提示頂き大変助かります。

ご質問に対しての回答が遅くなり申し訳ありませんでした。

ご質問の回答をさせて頂きます。

〉〉ちなみに、キーとする文字は数字ではなく、Cなどのアルファベットになる可能性もあるので変更可能なようであれば助かります。

〉これは４行目のことだね？
〉で、仮に、そこに C と入っていれば、どうしたい？
〉メッセージを出して、正しい桁数をいれさせる？

→言葉足らずで分かりづらく申し訳ありませんでした。
4行目についてのことです。
この4行目は例では文字は1、数字は2としていますが単純に１がアルファベットのXや2がCに置き換わるかもしれないということです。

頂いたコードでいえば、

If k = 2 Then '数字をCに変更If k = C Then
としても良いでしょうか？ということです。

実は、この4行目は将来的にVBAで他のファイルからのデータの種別をコピーして張り付け、という作業をする予定です。それをテキストファイル作成の前に組み込むことが目標です。
手入力で入れますと間違いなど生じますし、作業は全く他の方が行いますので出来るだけ簡略化したいのです。
それでその組み込む予定のデータ種別が記載されているファイルなのですが、まだ集約が出来ておらず・・。

そちらには文字を意味するコードが1ではなく、Xだったり、または例えばですが、1～9の全ての数字が数字を表し、Cが文字を意味したり・・などという可能性があるのです。

ですので、
If k = 1 or 2 or 3 or 4 or 5 or 6 or 7 or 8 or 9 Then '数字
などと単純に置き換えさせていただければ動くと助かるな・・と。
上記で動くかは本日はいただいたコードを試せておりませんので検証しておりません。

もしかすると単純に置き換えでは動かない場合もあるかもしれないと質問時に素人考えで思いましたので記載させていただきました。

何かご不明点ございましたら、再度お答させて頂きます。

二つもコードをありがとうございます。
まずは、頂いたコードの動作を明日以降見させていただきます。
コードもにらめっこしてみます！

ちなみに、
〉列数を 5(A～E)に固定しているけど、ここは、動的に最終列を判断することもできる。
→こちらは、列数は都度代わりますので最終列は固定せずに都度最終列までみるようなコードですと大変助かります。
重ねがさね申し訳ございません。

宜しくお願い致します。

（ちー）

 >列数は都度代わりますので最終列は固定せずに都度最終列までみるようなコードですと大変助かります。

 Sample,Sample2 ともに

 Dim Cols As Long を追加。

 keyV = .Range("A3:E4").Value を以下のように。

 cols = .cells(3,.columns.Count).End(xlToLeft).Column
 keyV = .Range("A3:A4").Resize(,cols).Value

 で、For j = 1 To 5　を　For j = 1 To cols に。

 >この4行目は例では文字は1、数字は2としていますが単純に１がアルファベットのXや2がCに置き換わるかもしれないということです
 >If k = 2 Then '数字をCに変更If k = C Then としても良いでしょうか？ということです。

　1(数値) が C(文字列) にかわるなら If k = "C" Then というように " で囲む必要があるけど、考え方として、これでＯＫ。

 ただし、現在は　○○だったら　というコードだけど、○○　か　■■　か　△△　だったら　ということになる可能性もあるなら
 以下にいくつか、サンプルを。A1 に何か任意の値を入れて、判定コードでどのように扱われるか試してみて。
 で、将来、コードが増えたとき、これらの中で使いやすいものを使えばいいと思う。

 Test1,2,3は　1,"C",9 のいずれかをチェック。
 (Test3は、つい最近　seiya さんが別スレでアップされたコードを借用）
 Test4 は、値が数字かどうかのチェックをしている。
 また Test5 は　値が 0 から 9 かのチェックをしている。

 Sub Test1()
    Dim k As Variant
    k = Range("A1").Value

    If k = 1 Or k = "C" Or k = 9 Then
        MsgBox "条件一致"
    Else
        MsgBox "条件不一致"
    End If

 End Sub

 Sub Test2()
    Dim k As Variant
    k = Range("A1").Value

    Select Case k
        Case 1, "C", 9
            MsgBox "条件一致"
        Case Else
            MsgBox "条件不一致"
    End Select

 End Sub

 Sub Test3()
    Dim k As Variant
    k = Range("A1").Value

    If k Like "[1|C|9]" Then
        MsgBox "条件一致"
    Else
        MsgBox "条件不一致"
    End If

 End Sub

 Sub Test4()
    '指定キーが数字だったら
    Dim k As Variant
    k = Range("A1").Value

    If IsNumeric(k) Then
        MsgBox "条件一致"
    Else
        MsgBox "条件不一致"
    End If
 End Sub

 Sub Test5()
    '指定キーが　0 から 9 の数字だったら
    Dim k As Variant
    k = Range("A1").Value

    Select Case k
        Case 0 To 9
            MsgBox "条件一致"
        Case Else
            MsgBox "条件不一致"
    End Select

 End Sub

 (ぶらっと)

(ぶらっと)様

お返事ありがとうございます。
また、私の希望に対応して頂いて本当に感謝致します。

これから様々なパターンで動きを検証していきたいと思います。
とり急ぎ御礼申し上げます。

コードもしっかり読み込み、検証後また質問させていただくこともあるかもしれません。
どうぞ宜しくお願い致します。

ありがとうございました。

（ちー）

(ぶらっと)様

先日はお助け頂いてありがとうございました。

現在コードと動きを勉強しておりますが、上手くいかず教えて頂ければと思い書き込みさせていただきました。

私の希望により、テキストファイルへ読み込む最終列はＥ列までと固定せず、その都度存在する最終列まで処理したいと申し上げました。

ぶらっと様により、
＞Sample,Sample2 ともに

＞Dim Cols As Long を追加。

＞keyV = .Range("A3:E4").Value を以下のように。

＞cols = .cells(3,.columns.Count).End(xlToLeft).Column
＞keyV = .Range("A3:A4").Resize(,cols).Value

＞で、For j = 1 To 5　を　For j = 1 To cols に。

と教えていただいたので修正してみたのですが・・。
Ｅ列までのデータの場合はテキストファイル出力出来るのですが、Ｆ列以降にデータと指定キー、桁数などを記載して動かしますと
「実行時エラー９、インデックスが有効範囲にありません」と出てしまいます。

これはなぜでしょうか？
他にもどこかコードの修正が必要なのかと思いましたがよくわかりませんでした。

教えていただけませんでしょうか。

どうぞ宜しくお願い致します。

（ちー）

(ぶらっと）様

上記の件で、記載がもれていました。
エラーとなるのは次のコードの部分です。

w(j) = Left(w(j) & WorksheetFunction.Rept(" ", n), n)

度々申し訳ございませんが、宜しくお願い致します。

（ちー)

 下から失礼します。

 中身を理解していませんが、エラーの通り w の配列のインデックスがデータ範囲
 を超えたのではないでしょうか。

 w の設定をしている Resize の中の 5 も Cols に変更する必要があるかと思います。
 (Mook)

 Mookさん　フォロー深謝。

 ちーさん

 Mookさんの指摘通り、もう１か所。

 w = WorksheetFunction.Index(Range("A" & i).Resize(, 5).Value, 1, 0)

 これを

 w = WorksheetFunction.Index(Range("A" & i).Resize(, cols).Value, 1, 0)

 に変えてね。

 (ぶらっと)

 (Mook)様

教えていただきありがとうございました！

ご指摘部分を修正しましたら正しく動きました。
エラーが表示された部分のみをじっと見つめていました・・。

ありがとうございました。

（ちー）

(ぶらっと）様

ありがとうございました！
変更したところ正しく動きました。

大変助かります。

やはり内容が理解出来ていないとちょっとした変更にも対応出来ずだめですね・・。
これから時間はかかりますがなんとかコードを理解していきたいと思います。

配列も使用したことがなかったので、しっかり勉強していきたいです。
たくさんの勉強要素が詰まっているコードだなと思いました。

ありがとうございました。

また何かございましたらどうぞ宜しくお願い致します。

（ちー）

コメント返信：

[ 一覧(最新更新順) ]

[[20121210210524]] 『テキストファイル出力』（ちー） ページの最後に飛ぶ

[[20121210210524]]　『テキストファイル出力』（ちー）　ページの最後に飛ぶ