Excelシートを固定長のテキストファイルに変換

Question

エクセル2000で、シートをテキストファイル
（prnファイル）に落とすVBAを作っています。

現在、以下のようなコード（OK Webで教えていただいた
方法）で、スペース区切りでA5からC10までをテキスト
ファイルに落とす、というような方法を使っています。

ここから、A列は100バイト、B列は150バイト、
C列は50バイトというように列の長さを固定して
テキストファイルに落とすようにしたいのですが、
どのようにすればよろしいのでしょうか？


以下はプログラムで使っている変数名です。
・sMyFilenameは出力するファイル名
・lRowNumbは5行目から10行目までを指定。
・nColumNumbはA列からX列までを指定。


nFrn = FreeFile(0)
Open sMyFilename For Output As #nFrn　

For lRowNumb = 5 To 10
  For nColumNumb = 1 To 3

    sData = .Cells(lRowNumb, nColumNumb).Value

    If nColumNumb < 3 Then
      Print #nFrn, sData & " ";
    Else
      Print #nFrn, sData
    End If

  Next nColumNumb
Next lRowNumb

Close #nFrn

TAGOSAKU7 · Accepted Answer

サンプルを作りました。

ファイル名などを固定にしていますが、そこら辺は読み替えてください。
それと毎回読んだデータをすぐに書きに行っていたので、一行ずつ書き込むように変更しています。
大きな違いはfixStrというオリジナル関数を追加しています。
この関数で、固定長の文字列として取得できます。

VBでは文字長に関係するときは
　　StrConv("文字列", vbFromUnicode)
というのをよく使います。


Sub Main()
　　Dim nFrn　　　　As Long
　　Dim lRowNumb　　As Long
　　Dim nColumNumb　As Long
　　Dim sData　　　 As String
　　
　　Dim FixByte　　 As Variant　'固定長バイト数をあらわす配列
　　Dim strOutPut　 As String　 '出力する文字列
　　Dim wkStr　　　 As String　 'ワークの文字列
　　
　　'各列のバイト数をセット（配列０の要素にダミーの値をセット）
　　FixByte = Array(0, 100, 150, 50)

　　nFrn = FreeFile(0)
　　Open "c:\1.txt" For Output As #nFrn
　　
　　　　For lRowNumb = 5 To 10
　　　　　　'出力文字の初期化
　　　　　　strOutPut = ""
　　　　　　For nColumNumb = 1 To 3
　　　　　　　　'とりあえず書かれている内容を取得
　　　　　　　　sData = Cells(lRowNumb, nColumNumb).Value
　　　　　　　　
　　　　　　　　'固定長のバイト数で調整を行う、ダミーの文字列として、" "スペースを使用
　　　　　　　　wkStr = fixStr(sData, CLng(FixByte(nColumNumb)), " ")
　　　　　　　　
　　　　　　　　'文字列の連結を行う
　　　　　　　　strOutPut = strOutPut & wkStr
　　　　　　Next nColumNumb
　　　　　　
　　　　　　'文字列の出力
　　　　　　Print #nFrn, strOutPut
　　　　Next lRowNumb
　　
　　Close #nFrn
End Sub

'文字数をパラメータの文字列で調整して返す関数
'引数１．調整される文字列
'引数２．バイト長
'引数３．固定長の調整文字
Private Function fixStr(inStrings As String, inLength As Long, inDmyStr As String) As String
　　Dim wkStr　 As String　 'ワークの文字列
　 
　　'引数の文字列に、引数の長さの分だけのv調整文字を追加して一時記憶
　　wkStr = inStrings & String(inLength, inDmyStr)
　 
　　'FromUnicodeに変換
　　wkStr = StrConv(wkStr, vbFromUnicode)
　 
　　'左からinLength分の文字を取得
　　wkStr = LeftB(wkStr, inLength)
　 
　　'Unicodeに変換して返す
　　fixStr = StrConv(wkStr, vbUnicode)
End Function

TAGOSAKU7 · Answer

補足です。（StrConvについて）

VBで文字列をそのままLen関数にかけると、文字数が返ってきます。LenBだと文字数の２倍の値が返ってきます。

一度
Dim wkByte() as Byte
と宣言して
wkByte = "あいbうcえお"  '←半角と全角の混合
として、実行してみてください。
wkByteは１文字につき、配列２個を使用する変数になっています。このときは０～１３までの配列要素をもった配列になってると思います。
配列要素偶数番目には０以外の数字が入っているはずです。配列要素奇数番目には、０が入っていたり入っていなかったりすると思います。
それがポイントです。
奇数番目に０が入っているのは、その直前の配列要素の値で文字を表現していることになります。

その０の値を無視してカウントさせる処理をStrConvでやってると思っていただければ結構です。

urk · Answer

そうですね。#2 は文字数なのでNGです。_(* *)_
　wkStr = fixStr(sData, CLng(FixByte　　　　(nColumNumb)), " ") 
でやらないといけません。

TAGOSAKU7 · Answer

urkさん（#2）への補足です。

>sData = Left(sData, DLen) 
>sData = sData & Space(DLen - Len(sData)) 
この部分はバイト数ではなく、文字数で行っています。
sDataに全角文字がないときはOKですが、もしあるのであればNGです。

urk · Answer

ワウ　もうサンプルがありましたか
私もサンプル作ってみました。
ちょっと列でのデータ長処理泥臭くやってみました。
#1の方が汎用的でスマートですね。

Sub test1()
Dim sData As String
Dim DLen As Long　　'列でのデータ長さ
Const sMyFilename As String = "C:\My Documents\OKWeb	est1.txt"

nFrn = FreeFile(0)
Open sMyFilename For Output As #nFrn


For lRowNumb = 5 To 10
　　For nColumNumb = 1 To 3
　　　'とりあえずデータ取得        
　　　sData = Cells(lRowNumb, nColumNumb).Value
　　　Select Case nColumNumb
　　　　　Case 1   '1列目
　　　　　　DLen = 100  'byte
　　　　　　sData = Left(sData, DLen)
　　　　　　sData = sData & Space(DLen - Len(sData))
　　　　　Case 2　　'２列目
　　　　　　DLen = 150  'Byte
　　　　　　sData = Left(sData, DLen)
　　　　　　sData = sData & Space(DLen - Len(sData))
　　　　　Case 3    '3列目
　　　　　　DLen = 50   'Byte
　　　　　　sData = Left(sData, DLen)
　　　　　　sData = sData & Space(DLen - Len(sData))
　　　　　Case Else
　　　　　　MsgBox (" Error")
　　　　　　Exit Sub
　　　　End Select
　　　　Print #nFrn, sData;  '改行しない
　　　Next nColumNumb
　　　　Print #nFrn, ""　'ここで改行
　　Next lRowNumb

Close #nFrn
End Sub

Excelシートを固定長のテキストファイルに変換

サンプルを作りました。

この回答への補足

補足です。

そうですね。

urkさん（#2）への補足です。

ワウ もうサンプルがありましたか

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

ワウ　もうサンプルがありましたか