excel2003

質問

下記の記述を入れています。

固定長ファイルを「貼付」シートのA1に取込、「2G」シートのE1～に各桁数を指定しています。
（E301まであります。）
また1つめの「" "」は半角。2つめの「"　"」は全角。半角スペースが入っている場合は「*」を。
全角スペースが入っている場合は「×」を。

Range("E1").Select
ActiveCell.FormulaR1C1 = _
"=MID(SUBSTITUTE(SUBSTITUTE(貼付!RC[-4],"" "",""*""),""　"",""×""),1,5)"
Range("E2").Select
ActiveCell.FormulaR1C1 = _
"=MID(SUBSTITUTE(SUBSTITUTE(貼付!R[-1]C[-4],"" "",""*""),""　"",""×""),6,4)"
Range("E3").Select
ActiveCell.FormulaR1C1 = _
"=MID(SUBSTITUTE(SUBSTITUTE(貼付!R[-2]C[-4],"" "",""*""),""　"",""×""),10,6)"
Range("E4").Select
ActiveCell.FormulaR1C1 = _
"=MID(SUBSTITUTE(SUBSTITUTE(貼付!R[-3]C[-4],"" "",""*""),""　"",""×""),16,12)"
Range("E5").Select
ActiveCell.FormulaR1C1 = _
"=MID(SUBSTITUTE(SUBSTITUTE(貼付!R[-4]C[-4],"" "",""*""),""　"",""×""),28,12)"

【質問内容】
固定長ファイルを「貼付」シートのA1に取込、「2G」シートのE1～E301に
各桁数を指定しているのですが、固定長ファイルの内容は1行とは限りません。
複数行（例：A1～A50）までの固定長ファイルを「2G」シートのE1-E301～BB1～BB301に
各桁数を指定する記述はありますでしょうか？

同じような事を繰り返してしまうとかなり長くなってしまい、マクロを組む意味がなくなります。

お分かりになりましたらご回答頂ければと思います。

宜しくお願い致します。

回答No.3

mt2008 · ベストアンサー

これ、Excel2003の問題ですね。
Excel2003はセルに表示できるのが1024文字なので

sString = Sheets("貼付").Range("A" & i).Text　で、取り出すと1024文字だけになってしまいます。
「.Text」を取って……
sString = Sheets("貼付").Range("A" & i)　これなら大丈夫だと思います。

お礼

！！！
有難うございました！
できました！！

本当に、本当に助かりました！

ただ・・・
実は、もうちょっと手を加えたい所がありまして・・・
来週、月曜日に再度質問すると思いますので、
もし宜しければまたご回答頂けると嬉しいです。

本当に有難うございました。

回答No.2

mt2008

こちらの環境（Excel2010）ではちゃんと動きましたよ。

「データが反映されない」と言っている辺りでWindowsの一つの区切りである1024文字を超えています。
貼付シートにどうやって文字列を入れているのか知りませんが、1024文字しか入っていない可能性はありませんか？ちゃんと1578文字入っていますか？

補足

ご確認・ご回答有難うございます。

ご指摘のありました、

>貼付シートにどうやって文字列を入れているのか
→固定長ファイルの内容をコピーし、貼付シートA1にそのまま貼付けています。

>1024文字しか入っていない可能性はありませんか
→全体の文字数は4170文字で貼付シートA1に4170文字存在しています。
（サクラエディタで確認）

今回は試しに1578文字まで設定しました。

mt2008さんの方では正常に動作したとの事ですので、
再度、こちら側で確認してみたいと思います。

有難うございました。

回答No.1

mt2008

こういう事がしたいのかな？

Sub Sample()
　　vLeng = Array(5, 4, 6, 12, 12) '←取り出す文字数
　　For i = 1 To Sheets("貼付").Range("A" & Rows.Count).End(xlUp).Row
　　　　sString = Sheets("貼付").Range("A" & i).Text
　　　　sString = Replace(Replace(sString, " ", "*"), "　", "×")
　　　　nPos = 1
　　　　For j = 0 To UBound(vLeng)
　　　　　　Sheets("2G").Cells(j + 1, i + 4) = Mid(sString, nPos, vLeng(j))
　　　　　　nPos = nPos + vLeng(j)
　　　　Next j
　　Next i
End Sub

補足

すごいです！
できました！有難うございます。

しかし・・・
見にくいですが、下記取り出す文字数を指定しているにも関わらず、途中から内容が反映されません。
なぜでしょうか？制限数でもあるのでしょうか？

具体的に、取り出す文字数の上から５行目：真ん中あたりから反映されません。
6, 12, 8, 6, 12, 8, 6, 12, 8, 0, 100, 30, 1, 1, 10, _
10, 23, 1, 20, 8, 100, 100, 30, 25, 23, 20) '

Sub Sample()

vLeng = Array(5, 4, 6, 12, 12, 8, 23, 19, 1, 1, 6, 3, 13, 1, 12, 10, 1, 7, 20, 1, 3, _
30, 25, 25, 2, 7, 1, 8, 3, 1, 0, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, _
6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, _
6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, _
6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 6, 12, 8, 0, 100, 30, 1, 1, 10, _
10, 23, 1, 20, 8, 100, 100, 30, 25, 23, 20) '←取り出す文字数
For i = 1 To Sheets("貼付").Range("A" & Rows.Count).End(xlUp).Row
sString = Sheets("貼付").Range("A" & i).Text
sString = Replace(Replace(sString, " ", "*"), "　", "×")
nPos = 1
For j = 0 To UBound(vLeng)
Sheets("2G").Cells(j + 1, i + 4) = Mid(sString, nPos, vLeng(j))
nPos = nPos + vLeng(j)
Next j
Next i
End Sub

再度、ご回答頂ければ非常に助かります。
宜しくお願い致します。