Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


13228 / 13644 ツリー ←次へ | 前へ→

【5035】セルの内容をテキストに 花粉症 03/4/18(金) 14:42 質問
【5040】Re:セルの内容をテキストに ichinose 03/4/18(金) 17:36 回答
【5041】Re:セルの内容をテキストに BOTTA 03/4/18(金) 18:24 回答
【5051】Re:セルの内容をテキストに 花粉症 03/4/19(土) 10:02 お礼
【5052】Re:セルの内容をテキストに 花粉症 03/4/19(土) 10:07 お礼
【5053】Re:セルの内容をテキストに ichinose 03/4/19(土) 11:40 回答
【5055】Re:セルの内容をテキストに 花粉症 03/4/19(土) 12:31 お礼
【5820】Re:セルの内容をテキストに リト 03/6/2(月) 18:45 質問
【5872】Re:セルの内容をテキストに BOTTA 03/6/5(木) 10:13 回答
【5883】Re:セルの内容をテキストに リト 03/6/5(木) 19:38 質問
【5886】Re:セルの内容をテキストに BOTTA 03/6/6(金) 10:33 回答
【5890】Re:セルの内容をテキストに リト 03/6/6(金) 15:35 質問
【5895】Re:セルの内容をテキストに BOTTA 03/6/6(金) 20:35 回答
【6354】Re:セルの内容をテキストに あやか 03/6/25(水) 17:36 質問
【6369】Re:セルの内容をテキストに BOTTA 03/6/26(木) 13:47 回答
【6372】Re:セルの内容をテキストに あやか 03/6/26(木) 14:37 質問
【6381】Re:セルの内容をテキストに BOTTA 03/6/26(木) 17:01 回答
【6383】手作業ですけど...。 Jaka 03/6/26(木) 17:25 発言
【6389】Re:手作業ですけど...。 あやか 03/6/27(金) 1:25 質問
【6392】すみません。全部忘れてください。 Jaka 03/6/27(金) 11:14 発言
【6395】Re:すみません。全部忘れてください。 あやか 03/6/27(金) 11:44 お礼
【6418】Re:すみません。全部忘れてください。 Jaka@浅草橋 03/6/28(土) 13:29 回答
【6420】忘れてませんでしたよ〜。 あやか 03/6/28(土) 17:12 質問
【6442】Re:忘れてませんでしたよ〜。 Jaka 03/6/30(月) 10:04 回答
【6448】あ、それと..。 Jaka 03/6/30(月) 13:02 回答
【6457】Re:あ、それと..。 あやか 03/6/30(月) 22:07 お礼
【6388】Re:セルの内容をテキストに あやか 03/6/27(金) 1:13 お礼
【6393】Re:セルの内容をテキストに ポンタ 03/6/27(金) 11:26 回答
【6397】Re:セルの内容をテキストに あやか 03/6/27(金) 12:00 質問
【6399】Re:セルの内容をテキストに ポンタ 03/6/27(金) 12:30 回答
【6400】Re:セルの内容をテキストに あやか 03/6/27(金) 13:00 質問
【6401】Re:セルの内容をテキストに ポンタ 03/6/27(金) 13:09 回答
【6402】Re:セルの内容をテキストに あやか 03/6/27(金) 13:18 質問
【6406】Re:セルの内容をテキストに ポンタ 03/6/27(金) 14:10 回答
【6407】Re:セルの内容をテキストに ポンタ 03/6/27(金) 14:23 回答
【6408】Re:セルの内容をテキストに あやか 03/6/27(金) 14:28 質問
【6410】Re:セルの内容をテキストに ポンタ 03/6/27(金) 14:51 回答
【6411】Re:セルの内容をテキストに あやか 03/6/27(金) 15:00 お礼
【6422】Re:セルの内容をテキストに あやか 03/6/28(土) 23:13 質問
【6428】Re:セルの内容をテキストに あやか 03/6/29(日) 23:33 回答
【6423】Re:セルの内容をテキストに あやか 03/6/28(土) 23:15 質問
【6441】Re:セルの内容をテキストに ポンタ 03/6/30(月) 9:38 回答
【6459】できたぁぁぁぁ! あやか 03/7/1(火) 19:46 お礼
【6424】Re:セルの内容をテキストに あやか 03/6/29(日) 1:32 質問
【6429】Re:セルの内容をテキストに あやか 03/6/29(日) 23:34 回答

【5035】セルの内容をテキストに
質問  花粉症  - 03/4/18(金) 14:42 -

引用なし
パスワード
   よろしくお願いします。花粉症です

VBAでテキストを取り込んで、編集するマクロを
作成中です。
その中で、あるセルの内容をテキストに書き出し
たいんですが、VBAではどうしたらいいんでしょうか。

よろしくお願いします。

【5040】Re:セルの内容をテキストに
回答  ichinose  - 03/4/18(金) 17:36 -

引用なし
パスワード
   ▼花粉症 さん:

こんにちは。
>よろしくお願いします。花粉症です
私、そろそろ花粉症、終結です。

>VBAでテキストを取り込んで、編集するマクロを
>作成中です。
>その中で、あるセルの内容をテキストに書き出し
>たいんですが、VBAではどうしたらいいんでしょうか。
>
>よろしくお願いします。
例題は、アクティブシートのセルA1〜A4の内容をテキストファイルに書き込むものです。
標準モジュール(Module1)に、
'======================================================
Sub テキスト出力()
  Dim flnm
  flnm = Application.GetSaveAsFilename(fileFilter:="テキスト ファイル (*.txt), *.txt")
  If flnm <> False Then
    If open_file_output(flnm) = 0 Then
     Set rng = Range("a1:a4")
     For idx = 1 To rng.Count
      If put_file(rng.Cells(idx).Value) <> 0 Then
        Exit For
        End If
      Next
     Call close_file
     End If
    End If
End Sub

標準モジュール(Module2)に、
'=============================================================
Dim flno As Long
'===============================
Function open_file_output(flnm)
  On Error Resume Next
  open_file_output = 0
  flno = FreeFile
  Open flnm For Output As #flno
  If Err.Number <> 0 Then
    MsgBox Error$(Err.Number) & ":" & Err.Number
    open_file_output = Err.Number
    End If
  On Error GoTo 0
End Function
'==========================================
Function put_file(f_data As Variant) As Long
  On Error Resume Next
  put_file = 0
  Print #flno, f_data
  If Err.Number <> 0 Then
    MsgBox Error(Err.Number) & ":" & Err.Number
    put_file = Err.Number
    End If
  On Error GoTo 0
End Function
'===========================================
Sub close_file()
  On Error Resume Next
  Close #flno
  On Error GoTo 0
End Sub

でテキストファイルが作成されました。

【5041】Re:セルの内容をテキストに
回答  BOTTA  - 03/4/18(金) 18:24 -

引用なし
パスワード
   花粉症さん、ichinoseさん、こんにちは。
FileSystemObjectを使って、

Sub aaa01()
Dim FSO As Object, objText As Object, Fname As String
  Fname = "C:\My Documents\test.txt" '←正しいファイル名にしてね
  Set FSO = CreateObject("Scripting.FileSystemObject")
  '↓書き込み専用でOpen、無ければファイルを作成
  Set objText = FSO.OpenTextFile(Fname, 2, True)
  '↓Sheet1のA1セルの内容を書出す
  objText.Write Range("A1").Value
  objText.Close
  Set objText = Nothing
  Set FSO = Nothing
End Sub

'複数セル対応
Sub aaa02()
Dim FSO As Object, objText As Object, Fname As String
Dim Rngs As Range, Rng As Range
  Fname = "C:\My Documents\test.txt" '←正しいファイル名にしてね
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set objText = FSO.OpenTextFile(Fname, 2, True)
  'Sheet1のA1〜A4セルの内容を書出す
  Set Rngs = Range("A1:A4")
  For Each Rng In Rngs
  objText.WriteLine Rng.Value
  Next
  objText.Close
  Set objText = Nothing
  Set FSO = Nothing
End Sub

【5051】Re:セルの内容をテキストに
お礼  花粉症  - 03/4/19(土) 10:02 -

引用なし
パスワード
   ありがとうございました。BOTTA さん。

教えてもらった通りに、修正したら無事、テキストを
書き出せました。
お世話になりました。

ついでに、厚かましいかなと思いますが、、質問です。
セルの中の文章で、置換をかけているんですが、
”―”を置換すると、”ー”も同じ文字に変換されます。
VBAの中では、同じコードとして認識してるんでしょうか。
解決方法はありませんか。

【5052】Re:セルの内容をテキストに
お礼  花粉症  - 03/4/19(土) 10:07 -

引用なし
パスワード
   ichinose さん。回答をありがとうございました。

いろんなやり方があるんで、勉強になりました。
ありがとうございました。

それで、テキストは書き出せたんですが、新たな問題がでたので
すみませんが改めて質問です。
セルの中の文章で、置換をかけているんですが、文中の
”―”を置換すると、”ー”(音引き)も同時に変換されます。
同じコードとして処理してるんでしょうが、解決方法はありませんか。

>▼花粉症 さん:
>
>こんにちは。
>>よろしくお願いします。花粉症です
>私、そろそろ花粉症、終結です。
>
>>VBAでテキストを取り込んで、編集するマクロを
>>作成中です。
>>その中で、あるセルの内容をテキストに書き出し
>>たいんですが、VBAではどうしたらいいんでしょうか。
>>
>>よろしくお願いします。
>例題は、アクティブシートのセルA1〜A4の内容をテキストファイルに書き込むものです。
>標準モジュール(Module1)に、
>'======================================================
>Sub テキスト出力()
>  Dim flnm
>  flnm = Application.GetSaveAsFilename(fileFilter:="テキスト ファイル (*.txt), *.txt")
>  If flnm <> False Then
>    If open_file_output(flnm) = 0 Then
>     Set rng = Range("a1:a4")
>     For idx = 1 To rng.Count
>      If put_file(rng.Cells(idx).Value) <> 0 Then
>        Exit For
>        End If
>      Next
>     Call close_file
>     End If
>    End If
>End Sub
>
>標準モジュール(Module2)に、
>'=============================================================
>Dim flno As Long
>'===============================
>Function open_file_output(flnm)
>  On Error Resume Next
>  open_file_output = 0
>  flno = FreeFile
>  Open flnm For Output As #flno
>  If Err.Number <> 0 Then
>    MsgBox Error$(Err.Number) & ":" & Err.Number
>    open_file_output = Err.Number
>    End If
>  On Error GoTo 0
>End Function
>'==========================================
>Function put_file(f_data As Variant) As Long
>  On Error Resume Next
>  put_file = 0
>  Print #flno, f_data
>  If Err.Number <> 0 Then
>    MsgBox Error(Err.Number) & ":" & Err.Number
>    put_file = Err.Number
>    End If
>  On Error GoTo 0
>End Function
>'===========================================
>Sub close_file()
>  On Error Resume Next
>  Close #flno
>  On Error GoTo 0
>End Sub
>
>でテキストファイルが作成されました。

【5053】Re:セルの内容をテキストに
回答  ichinose  - 03/4/19(土) 11:40 -

引用なし
パスワード
   ▼花粉症 さん:
おはようございます。
どういうコードで置換処理してますか?
私が調べた限りでは、RangeのReplceメソッドでMathccaseオプションを省略したと
きに
>”―”を置換すると、”ー”(音引き)も同時に変換されます。
が起きていました。
例えば
range("a1:a4").replace what:="―", replacement:="○"

これを使用しているのでしたら
range("a1:a4").replace what:="―", replacement:="○",matchcase:=true

で”ー”は変換対象になりません。

文字列の置換処理は、
他にもReplace関数(2000以上ですが、個人的には簡単なので使っていますが)とかワークシート関数のSUBSTITUTE関数等でもできますが、これらはちゃんと区別してくれてました。


>それで、テキストは書き出せたんですが、新たな問題がでたので
>すみませんが改めて質問です。
>セルの中の文章で、置換をかけているんですが、文中の
>”―”を置換すると、”ー”(音引き)も同時に変換されます。
>同じコードとして処理してるんでしょうが、解決方法はありませんか。

>>標準モジュール(Module1)に、
>>'======================================================
>>Sub テキスト出力()
>>  Dim flnm
>>  flnm = Application.GetSaveAsFilename(fileFilter:="テキスト ファイル (*.txt), *.txt")
>>  If flnm <> False Then
>>    If open_file_output(flnm) = 0 Then
>>     Set rng = Range("a1:a4")
      rng.Replace what:="―", replacement:="○", MatchCase:=True
>>     For idx = 1 To rng.Count
>>      If put_file(rng.Cells(idx).Value) <> 0 Then
>>        Exit For
>>        End If
>>      Next
>>     Call close_file
>>     End If
>>    End If
>>End Sub
>>

【5055】Re:セルの内容をテキストに
お礼  花粉症  - 03/4/19(土) 12:31 -

引用なし
パスワード
   ichinose さん こんにちは。

書かれていたものと作成中のマクロを比較したら
>range("a1:a4").replace what:="―", replacement:="○",matchcase:=true
の部分で、matchcase:=false となっていました。
trueに書き換えたらちゃんと変換されました。

falseとtrueの違いでこうなるのは、ちょっと不思議です。
なんでだろーという感じで、いまいち納得は出来ないんですが、
なにせVBA初心者のもので、もっと勉強が必要ですね。
とにかく、無事動きましてマクロが完成しました。
ありがとうございました。

【5820】Re:セルの内容をテキストに
質問  リト  - 03/6/2(月) 18:45 -

引用なし
パスワード
   >FileSystemObjectを使って、
>
>Sub aaa01()
>Dim FSO As Object, objText As Object, Fname As String
>  Fname = "C:\My Documents\test.txt" '←正しいファイル名にしてね
>  Set FSO = CreateObject("Scripting.FileSystemObject")
>  '↓書き込み専用でOpen、無ければファイルを作成
>  Set objText = FSO.OpenTextFile(Fname, 2, True)
>  '↓Sheet1のA1セルの内容を書出す
>  objText.Write Range("A1").Value
>  objText.Close
>  Set objText = Nothing
>  Set FSO = Nothing
>End Sub
>
>'複数セル対応
>Sub aaa02()
>Dim FSO As Object, objText As Object, Fname As String
>Dim Rngs As Range, Rng As Range
>  Fname = "C:\My Documents\test.txt" '←正しいファイル名にしてね
>  Set FSO = CreateObject("Scripting.FileSystemObject")
>  Set objText = FSO.OpenTextFile(Fname, 2, True)
>  'Sheet1のA1〜A4セルの内容を書出す
>  Set Rngs = Range("A1:A4")
>  For Each Rng In Rngs
>  objText.WriteLine Rng.Value
>  Next
>  objText.Close
>  Set objText = Nothing
>  Set FSO = Nothing
>End Sub

私もこの複数セル対応の方を利用してセルの内容をテキストデータに書き出したいを思い使わせてもらいました。
しかし、その際にセルとセルの間にスペースが入って書き出しされるのですが、スペースなしで全てを続けて書き出すにはどうしたらよいのでしょうか??
初心者なものでわかりませんでしたので教えてもらえませんか?

【5872】Re:セルの内容をテキストに
回答  BOTTA  - 03/6/5(木) 10:13 -

引用なし
パスワード
   リトさん、こんにちは。
>しかし、その際にセルとセルの間にスペースが入って書き出しされるのですが、スペースなしで全てを続けて書き出すにはどうしたらよいのでしょうか??

このコードではスペースではなく改行が挿入されるはず。
続けて書き出すには、WriteLineメソッドではなくWriteメソッドを使います。

Sub aaa02()
Dim fso As Object, objText As Object, Fname As String
Dim Rngs As Range, Rng As Range
  Fname = "C:\My Documents\test.txt" '←正しいファイル名にしてね
  Set fso = CreateObject("Scripting.FileSystemObject")
  '↓書き込み専用でOpen、無ければファイルを作成
  Set objText = fso.OpenTextFile(Fname, 2, True)
  'Sheet1のA1〜A4セルの内容を書出す
  Set Rngs = Range("A1:A4")
  For Each Rng In Rngs
    objText.Write Rng.Value
  Next
  objText.Close
  Set Rngs = Nothing: Set objText = Nothing: Set fso = Nothing
End Sub

【5883】Re:セルの内容をテキストに
質問  リト  - 03/6/5(木) 19:38 -

引用なし
パスワード
   BOTTAさん本当にありがとうございました。
きちんとつづけて書き出すことができました!

下の様な表記をした場合、範囲の指定を複数の行にしても全て並べて
書き出されますよね。(下の1.の感じ。)
それをそれぞれの行ごとに並べて書き出すにはどうしたら
いいのでしょうか???(下の2.ような感じです。)
もし、よろしければ教えていただけないでしょうか??

1.  Sheet1
1 2 3 4 5 6 7 8 9 0
1 2 3 4 5 6 7 8 9 0

  text
12345678901234567890


2. Sheet1
1 2 3 4 5 6 7 8 9 0
1 2 3 4 5 6 7 8 9 0

  text
1234567890
1234567890


>リトさん、こんにちは。
>>しかし、その際にセルとセルの間にスペースが入って書き出しされるのですが、スペースなしで全てを続けて書き出すにはどうしたらよいのでしょうか??
>
>このコードではスペースではなく改行が挿入されるはず。
>続けて書き出すには、WriteLineメソッドではなくWriteメソッドを使います。
>
>Sub aaa02()
>Dim fso As Object, objText As Object, Fname As String
>Dim Rngs As Range, Rng As Range
>  Fname = "C:\My Documents\test.txt" '←正しいファイル名にしてね
>  Set fso = CreateObject("Scripting.FileSystemObject")
>  '↓書き込み専用でOpen、無ければファイルを作成
>  Set objText = fso.OpenTextFile(Fname, 2, True)
>  'Sheet1のA1〜A4セルの内容を書出す
>  Set Rngs = Range("A1:A4")
>  For Each Rng In Rngs
>    objText.Write Rng.Value
>  Next
>  objText.Close
>  Set Rngs = Nothing: Set objText = Nothing: Set fso = Nothing
>End Sub

【5886】Re:セルの内容をテキストに
回答  BOTTA  - 03/6/6(金) 10:33 -

引用なし
パスワード
   リトさん、こんにちは。
>それをそれぞれの行ごとに並べて書き出すにはどうしたら
>  text
>1234567890
>1234567890
右端のセルに来たら、改行文字を書き出します。

Sub aaa02()
Dim fso As Object, objText As Object, Fname As String
Dim Rngs As Range, Rng As Range
Dim LstClm As Integer
  Fname = "C:\My Documents\test.txt"
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set objText = fso.OpenTextFile(Fname, 2, True)
  'Sheet1のA1〜J2セルの内容を書出す
  Set Rngs = Range("A1:J2")
  '対象セルの右端列番号取得
  LstClm = Rngs.Columns(Rngs.Columns.Count).Column
  For Each Rng In Rngs
    objText.Write Rng.Value
    '右端のセルの時、改行文字を挿入
    If Rng.Column = LstClm Then
      objText.WriteBlankLines 1
    End If
  Next
  objText.Close
  Set Rngs = Nothing: Set objText = Nothing: Set fso = Nothing
End Sub

【5890】Re:セルの内容をテキストに
質問  リト  - 03/6/6(金) 15:35 -

引用なし
パスワード
   BOTTAさん本当にありがとうございます。
自分の思ってるとおりのものができました。
図々しいようですが、もう一つ聞きたい事があります。
下のようにスペースの空いたセルはそのままにして書き出す方法です。
私の頭では全く考え付かないもので大変申し訳ないのですが、よろしければ
教えていただけないでしょうか?よろしくお願いします。

sheet1
ABCDEFGHIJ列
11234567890
212345 7890
31234567890

  ↓
TEXT
1234567890
12345 7890
1234567890


>右端のセルに来たら、改行文字を書き出します。
>
>Sub aaa02()
>Dim fso As Object, objText As Object, Fname As String
>Dim Rngs As Range, Rng As Range
>Dim LstClm As Integer
>  Fname = "C:\My Documents\test.txt"
>  Set fso = CreateObject("Scripting.FileSystemObject")
>  Set objText = fso.OpenTextFile(Fname, 2, True)
>  'Sheet1のA1〜J2セルの内容を書出す
>  Set Rngs = Range("A1:J2")
>  '対象セルの右端列番号取得
>  LstClm = Rngs.Columns(Rngs.Columns.Count).Column
>  For Each Rng In Rngs
>    objText.Write Rng.Value
>    '右端のセルの時、改行文字を挿入
>    If Rng.Column = LstClm Then
>      objText.WriteBlankLines 1
>    End If
>  Next
>  objText.Close
>  Set Rngs = Nothing: Set objText = Nothing: Set fso = Nothing
>End Sub

【5895】Re:セルの内容をテキストに
回答  BOTTA  - 03/6/6(金) 20:35 -

引用なし
パスワード
   リトさん、こんばんは。
>下のようにスペースの空いたセルはそのままにして書き出す方法です。

あらかじめ、スペースを入力しておけばご希望の結果が得られます。
自動でやるなら。
  Set Rngs = Range("A1:J3")
の下に、
  Rngs.SpecialCells(xlBlanks).Value = " "
を追加して下さい。

ただし、ワークシート上にもスペースが残ります。

【6354】Re:セルの内容をテキストに
質問  あやか E-MAIL  - 03/6/25(水) 17:36 -

引用なし
パスワード
   ▼リト さん:
>>FileSystemObjectを使って、
>>
>>Sub aaa01()
>>Dim FSO As Object, objText As Object, Fname As String
>>  Fname = "C:\My Documents\test.txt" '←正しいファイル名にしてね
>>  Set FSO = CreateObject("Scripting.FileSystemObject")
>>  '↓書き込み専用でOpen、無ければファイルを作成
>>  Set objText = FSO.OpenTextFile(Fname, 2, True)
>>  '↓Sheet1のA1セルの内容を書出す
>>  objText.Write Range("A1").Value
>>  objText.Close
>>  Set objText = Nothing
>>  Set FSO = Nothing
>>End Sub
>>
>>'複数セル対応
>>Sub aaa02()
>>Dim FSO As Object, objText As Object, Fname As String
>>Dim Rngs As Range, Rng As Range
>>  Fname = "C:\My Documents\test.txt" '←正しいファイル名にしてね
>>  Set FSO = CreateObject("Scripting.FileSystemObject")
>>  Set objText = FSO.OpenTextFile(Fname, 2, True)
>>  'Sheet1のA1〜A4セルの内容を書出す
>>  Set Rngs = Range("A1:A4")
>>  For Each Rng In Rngs
>>  objText.WriteLine Rng.Value
>>  Next
>>  objText.Close
>>  Set objText = Nothing
>>  Set FSO = Nothing
>>End Sub
>

BOTTAさん、私もこの複数セル対応の方を利用してセルの内容をテキストデータに書き出したいを思い使わせてもらいました。大変わかりやすくて助かります。
一部のセルで、金額を表示のしたいのですが桁数が違うとずれてきてしまいます。
バイト数を制限して表示したいのですが
どうしたらよいのでしょう。ご教授願います。

エクセル内容(入力内容は:以下)
A1(日付:030625) B1(金額: 1000) A3(消費税: 50) 
A2(日付:030626) B2(金額:30000) B3(消費税:150) 

書き出したテキスト内容
030625100050
03062630000150

を、
030625 1000  50
030626 30000  150

と表示したいのですが・・・
わかってもらえるでしょうか・・・。
すみません、おねがいします。

【6369】Re:セルの内容をテキストに
回答  BOTTA  - 03/6/26(木) 13:47 -

引用なし
パスワード
   あやかさん、こんにちは。

>エクセル内容(入力内容は:以下)
>A1(日付:030625) B1(金額: 1000) A3(消費税: 50) 
>A2(日付:030626) B2(金額:30000) B3(消費税:150) 
↑これセル番地違いますよね。

それから使ったコードは上の2つではなく、[#5886]ですよね。

これをちょっと修正。
セルの内容にタブ文字を加えて
    objText.Write Rng.Value & vbTab
とします。

Sub aaa03()
Dim fso As Object, objText As Object, Fname As String
Dim Rngs As Range, Rng As Range
Dim LstClm As Integer
  Fname = "C:\My Documents\test.txt"
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set objText = fso.OpenTextFile(Fname, 2, True)
  'Sheet1のA1〜C2セルの内容を書出す
  Set Rngs = Range("A1:C2")
  '対象セルの右端列番号取得
  LstClm = Rngs.Columns(Rngs.Columns.Count).Column
  For Each Rng In Rngs
    objText.Write Rng.Value & vbTab
    '右端のセルの時、改行文字を挿入
    If Rng.Column = LstClm Then
      objText.WriteBlankLines 1
    End If
  Next
  objText.Close
  Set Rngs = Nothing: Set objText = Nothing: Set fso = Nothing
End Sub

【6372】Re:セルの内容をテキストに
質問  あやか  - 03/6/26(木) 14:37 -

引用なし
パスワード
   BOTTA さん、こんにちは。お返事ありがとうございます。
ごめんなさい、的確な質問をしていなくて申し訳ありません。

>それから使ったコードは上の2つではなく、[#5886]ですよね。

その通りです。ごめんなさい。
その上、大事な事をお伝え損ねていました。
タブ等を使わずに指定した一部の範囲のみ桁そろえをしたいのです。
一度SaveAs・・・でやってみたのですがうまく行かなかったもので
BOTTAさんのを使わせていただこうと思いました。

エクセル内容(入力内容は:以下)
A1(問合せ番号:0001) B1(日付:030625) C1(金額: 1000) D1(消費税: 50) 
A2(問合せ番号:0002) B2(日付:030626) C2(金額:30000) D2(消費税:150)



0001030625  1000  50
0002030626 30000  150

(AとBの間にはタブを入れたくない)
せっかくお答えいただいたのに大変申し訳ありません。

【6381】Re:セルの内容をテキストに
回答  BOTTA  - 03/6/26(木) 17:01 -

引用なし
パスワード
   あやかさん、こんにちは。
>エクセル内容(入力内容は:以下)
>A1(問合せ番号:0001) B1(日付:030625) C1(金額: 1000) D1(消費税: 50)
>A2(問合せ番号:0002) B2(日付:030626) C2(金額:30000) D2(消費税:150)
>↓
>0001030625  1000  50
>0002030626 30000  150
>
>(AとBの間にはタブを入れたくない)
>せっかくお答えいただいたのに大変申し訳ありません。

テキスト形式では、タブ等を使わずには、文字と文字を区切ることが出来ません。
CSV形式などを使ってみては。

【6383】手作業ですけど...。
発言  Jaka  - 03/6/26(木) 17:25 -

引用なし
パスワード
   こんにちは。

マクロでなく、手作業ですけど...。
取合えずA、B列が文字列とであると前提としてます。

A列をコピーして取合えず新規シートのA列に貼りつけます。
(↑ 関数記入用時あった方が楽なため)
B1に下記関数を入れ、B1セルの右下角にポインタを合わせ、ポインタが「+」になった所でWクリック、関数が書きこまれたら、A列を削除して名前をつけて保存で、テキストを選べば...。

=Sheet1!A1&Sheet1!B1&Sheet1!C1&Sheet1!D1

【6388】Re:セルの内容をテキストに
お礼  あやか  - 03/6/27(金) 1:13 -

引用なし
パスワード
   BOTTA さん、どうもありがとうございました。
CSVで出力すると受け入れ先がNGなのです・・・。
受け入れできるようにはなっているはずなんですが。
元データの表示方式をそのままテキスト化できれば
一番いいのですが、うまくいきません。
他の方法を考えてみます。ご親切にありがとうございました。
お世話になりました。

【6389】Re:手作業ですけど...。
質問  あやか  - 03/6/27(金) 1:25 -

引用なし
パスワード
   Jakaさん、ありがとうございます。
おっしゃる通りにやってみると、
「数式を計算できません」とでますが・・・
やり方が間違っているかもしれないので
もう少し詳しく教えていただけるとありがたいです。


▼Jaka さん:
>こんにちは。
>
>マクロでなく、手作業ですけど...。
>取合えずA、B列が文字列とであると前提としてます。
>
>A列をコピーして取合えず新規シートのA列に貼りつけます。
>(↑ 関数記入用時あった方が楽なため)
>B1に下記関数を入れ、B1セルの右下角にポインタを合わせ、ポインタが「+」になった所でWクリック、関数が書きこまれたら、A列を削除して名前をつけて保存で、テキストを選べば...。
>
>=Sheet1!A1&Sheet1!B1&Sheet1!C1&Sheet1!D1

【6392】すみません。全部忘れてください。
発言  Jaka  - 03/6/27(金) 11:14 -

引用なし
パスワード
   >エクセル内容(入力内容は:以下)
>A1(日付:030625) B1(金額: 1000) A3(消費税: 50) 
>A2(日付:030626) B2(金額:30000) B3(消費税:150) 

>書き出したテキスト内容
>030625100050
>03062630000150

>を、
>030625 1000  50
>030626 30000  150

>と表示したいのですが・・・
>わかってもらえるでしょうか・・・。
>すみません、おねがいします。

こんな風になっているとは、全く読んでいませんでした。
ただ続けてテキスト保存したいのかと思っていました。
ごめんなさい。

データに規則性(データ行の文字数が決まっている。固定長)や区切り位置を示す目印が無いので無理です。

>030625100050
>03062630000150

普通は、テキストデータを下のように作りますけど。

固定長
03062500100050
03062630000150

カンマ区切り
030625,1000,50
030626,30000,150

タブ区切り
030625    1000    50
030626    30000    150

スペース区切り
030625 1000 50
030626 30000 150

【6393】Re:セルの内容をテキストに
回答  ポンタ  - 03/6/27(金) 11:26 -

引用なし
パスワード
   横から失礼します。

これでどうでしょう?

Sub test()
  Dim objFs As Object, objText As Object
  Dim FileName As String
  Dim MyStr As String
  Dim i As Long
  Dim 桁数1 As Integer, 桁数2 As Integer
  FileName = "C:\My Documents\test.txt"
  Set objFs = CreateObject("Scripting.FileSystemObject")
  Set objText = objFs.OpenTextFile(FileName, 2, True)
  桁数1 = Int(Log(WorksheetFunction.Max(Range("C:C"))) / Log(10)) + 2
  桁数2 = Int(Log(WorksheetFunction.Max(Range("D:D"))) / Log(10)) + 2
  For i = 1 To Range("A65536").End(xlUp).Row
    MyStr = Cells(i, 1).Value
    MyStr = MyStr & Cells(i, 2).Value
    MyStr = MyStr & String(桁数1 - Len(Cells(i, 3).Value), " ")
    MyStr = MyStr & Cells(i, 3).Value
    MyStr = MyStr & String(桁数2 - Len(Cells(i, 4).Value), " ")
    MyStr = MyStr & Cells(i, 4).Value
    Call objText.WriteLine(MyStr)
  Next
  objText.Close
  Set objText = Nothing
  Set objFs = Nothing
End Sub

【6395】Re:すみません。全部忘れてください。
お礼  あやか  - 03/6/27(金) 11:44 -

引用なし
パスワード
   Jakaさん、ありがとうございます。
SaveAsで元データの属性を拾うと可能なのですが
微妙に不具合がでるんです。
今は暗闇の中ですがもうちょっとがんばります。
ありがとうございました。

▼Jaka さん:
>>エクセル内容(入力内容は:以下)
>>A1(日付:030625) B1(金額: 1000) A3(消費税: 50) 
>>A2(日付:030626) B2(金額:30000) B3(消費税:150) 
>
>>書き出したテキスト内容
>>030625100050
>>03062630000150
>
>>を、
>>030625 1000  50
>>030626 30000  150
>
>>と表示したいのですが・・・
>>わかってもらえるでしょうか・・・。
>>すみません、おねがいします。
>
>こんな風になっているとは、全く読んでいませんでした。
>ただ続けてテキスト保存したいのかと思っていました。
>ごめんなさい。
>
>データに規則性(データ行の文字数が決まっている。固定長)や区切り位置を示す目印が無いので無理です。
>
>>030625100050
>>03062630000150
>
>普通は、テキストデータを下のように作りますけど。
>
>固定長
>03062500100050
>03062630000150
>
>カンマ区切り
>030625,1000,50
>030626,30000,150
>
>タブ区切り
>030625    1000    50
>030626    30000    150
>
>スペース区切り
>030625 1000 50
>030626 30000 150

【6397】Re:セルの内容をテキストに
質問  あやか  - 03/6/27(金) 12:00 -

引用なし
パスワード
   ポンタさん、こんにちは。
ありがとうございます。
解読をよそにそのままやってみると
「プロシージャの呼び出し、または引数が不正です」と
でてしまいました。
デバッグは
>  桁数1 = Int(Log(WorksheetFunction.Max(Range("C:C"))) / Log(10)) + 2
それから


▼ポンタ さん:
>横から失礼します。
>
>これでどうでしょう?
>
>Sub test()
>  Dim objFs As Object, objText As Object
>  Dim FileName As String
>  Dim MyStr As String
>  Dim i As Long
>  Dim 桁数1 As Integer, 桁数2 As Integer
>  FileName = "C:\My Documents\test.txt"
>  Set objFs = CreateObject("Scripting.FileSystemObject")
>  Set objText = objFs.OpenTextFile(FileName, 2, True)
>  桁数1 = Int(Log(WorksheetFunction.Max(Range("C:C"))) / Log(10)) + 2

     ↑ここのLog(*)でCの桁数を決めるんですよね?

>  桁数2 = Int(Log(WorksheetFunction.Max(Range("D:D"))) / Log(10)) + 2

     ↓ごめんなさい、このFor文がわからなくて・・・
      もしよければ指示の内容を教えてください。何から何まですみません。

>  For i = 1 To Range("A65536").End(xlUp).Row
>    MyStr = Cells(i, 1).Value
>    MyStr = MyStr & Cells(i, 2).Value
>    MyStr = MyStr & String(桁数1 - Len(Cells(i, 3).Value), " ")
>    MyStr = MyStr & Cells(i, 3).Value
>    MyStr = MyStr & String(桁数2 - Len(Cells(i, 4).Value), " ")
>    MyStr = MyStr & Cells(i, 4).Value
>    Call objText.WriteLine(MyStr)
>  Next
>  objText.Close
>  Set objText = Nothing
>  Set objFs = Nothing
>End Sub

【6399】Re:セルの内容をテキストに
回答  ポンタ  - 03/6/27(金) 12:30 -

引用なし
パスワード
   「プロシージャの呼び出し、または引数が不正です」と
でてしまいました。
デバッグは
>  桁数1 = Int(Log(WorksheetFunction.Max(Range("C:C"))) / Log(10)) + 2

こちらでテストした限りではエラーは出ていないので、よく分かりません。
(Win2000,Excel2000でテストしてます)

以下のコードだとどうなりますか?

Sub test1()
  Dim a
  a = WorksheetFunction.Max(Range("C:C"))
  a = Log(a)
  a = a / Log(10)
  a = a + 2
  a = Int(a)
  MsgBox (a)
End Sub


>>  桁数1 = Int(Log(WorksheetFunction.Max(Range("C:C"))) / Log(10)) + 2

>     ↑ここのLog(*)でCの桁数を決めるんですよね?

そうです。
最大値が"30000"の時はスペースを含めて6文字になれば良いと思うので、
6を返すように式を組み立ててあります。

>     ↓ごめんなさい、このFor文がわからなくて・・・
>      もしよければ指示の内容を教えてください。何から何まですみません。
>

  For i = 1 To Range("A65536").End(xlUp).Row
    'MyStrにA列の値をセット         MyStr = "0001"
    MyStr = Cells(i, 1).Value
    'MyStrの文末にB列の値を付け足す     MyStr="0001030625"
    MyStr = MyStr & Cells(i, 2).Value
    'Len(Cells(i, 3).Valueで"1000"の文字数を数える = 4
    '桁数1 = 6だから String(2, " ")となる
    'これは、スペース2文字(" ")を返す
    'よって MyStr="0001030625 " となる
    MyStr = MyStr & String(桁数1 - Len(Cells(i, 3).Value), " ")
    'C列の値を付け足す            MyStr="0001030625 1000"
    MyStr = MyStr & Cells(i, 3).Value
    'スペースを付け足す           MyStr="000130625 1000 "
    MyStr = MyStr & String(桁数2 - Len(Cells(i, 4).Value), " ")
    'D列の値を付け足す            MyStr="000130625 1000 50"
    MyStr = MyStr & Cells(i, 4).Value
    'テキストファイルに書き込む
    Call objText.WriteLine(MyStr)
  Next

こんな感じです。

【6400】Re:セルの内容をテキストに
質問  あやか  - 03/6/27(金) 13:00 -

引用なし
パスワード
   ポンタさーん、即レスありがとうございます。

こちらでもだめです。
a = Log(a)でひっかかってました。
私の環境はWin98、EXCEL2000です。
実際にはXP、EXCEL2000で走らせたいので
(テストの環境が整ってなくて・・・)
もしかしたらうまく行くかもしれません。
結果はお時間ください。

▼ポンタ さん:
>「プロシージャの呼び出し、または引数が不正です」と
>でてしまいました。
>デバッグは
>>  桁数1 = Int(Log(WorksheetFunction.Max(Range("C:C"))) / Log(10)) + 2
>
>こちらでテストした限りではエラーは出ていないので、よく分かりません。
>(Win2000,Excel2000でテストしてます)
>
>以下のコードだとどうなりますか?
>
>Sub test1()
>  Dim a
>  a = WorksheetFunction.Max(Range("C:C"))
>  a = Log(a)
>  a = a / Log(10)
>  a = a + 2
>  a = Int(a)
>  MsgBox (a)
>End Sub
>
>
>>>  桁数1 = Int(Log(WorksheetFunction.Max(Range("C:C"))) / Log(10)) + 2
>
>>     ↑ここのLog(*)でCの桁数を決めるんですよね?
>
>そうです。
>最大値が"30000"の時はスペースを含めて6文字になれば良いと思うので、
>6を返すように式を組み立ててあります。
>
>>     ↓ごめんなさい、このFor文がわからなくて・・・
>>      もしよければ指示の内容を教えてください。何から何まですみません。
>>

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

>
>  For i = 1 To Range("A65536").End(xlUp).Row

    ↑ここはRange("A")でもいいんですよね?
     やっぱり書き込んだほうが良いのでしょうか。

>    'MyStrにA列の値をセット         MyStr = "0001"
>    MyStr = Cells(i, 1).Value
>    'MyStrの文末にB列の値を付け足す     MyStr="0001030625"
>    MyStr = MyStr & Cells(i, 2).Value
>    'Len(Cells(i, 3).Valueで"1000"の文字数を数える = 4
>    '桁数1 = 6だから String(2, " ")となる
>    'これは、スペース2文字(" ")を返す
>    'よって MyStr="0001030625 " となる
>    MyStr = MyStr & String(桁数1 - Len(Cells(i, 3).Value), " ")
>    'C列の値を付け足す            MyStr="0001030625 1000"
>    MyStr = MyStr & Cells(i, 3).Value
>    'スペースを付け足す           MyStr="000130625 1000 "
>    MyStr = MyStr & String(桁数2 - Len(Cells(i, 4).Value), " ")
>    'D列の値を付け足す            MyStr="000130625 1000 50"
>    MyStr = MyStr & Cells(i, 4).Value
>    'テキストファイルに書き込む
>    Call objText.WriteLine(MyStr)
>  Next
>
>こんな感じです。

一度桁数からCを引いた結果をくっつけてから
Cを書くわけですね。わかりました、わかりました。

【6401】Re:セルの内容をテキストに
回答  ポンタ  - 03/6/27(金) 13:09 -

引用なし
パスワード
     桁数1 = Int(Log(WorksheetFunction.Max(Range("C:C"))) / Log(10)) + 2
  桁数2 = Int(Log(WorksheetFunction.Max(Range("D:D"))) / Log(10)) + 2



  桁数1 = Len(Str(WorksheetFunction.Max(Range("C:C"))))
  桁数2 = Len(Str(WorksheetFunction.Max(Range("D:D"))))

に置き換えてみてください。


> ↑ここはRange("A")でもいいんですよね?
>      やっぱり書き込んだほうが良いのでしょうか。

"Range("A65536").End(xlUp).Row"がA列の最終入力行を
求める決り文句のひとつです。

For i = 1 To Range("A65536").End(xlUp).Row

で「1行目〜A列最終入力行まで繰り返せ」となります。

【6402】Re:セルの内容をテキストに
質問  あやか  - 03/6/27(金) 13:18 -

引用なし
パスワード
   ポンタさん

Win98にて作動:
OKでしたが今度はここでひっかかりました。

MyStr = MyStr & String(桁数1 - Len(Cells(i, 3).Value), " ")

▼ポンタ さん:
>  桁数1 = Int(Log(WorksheetFunction.Max(Range("C:C"))) / Log(10)) + 2
>  桁数2 = Int(Log(WorksheetFunction.Max(Range("D:D"))) / Log(10)) + 2
>
>を
>
>  桁数1 = Len(Str(WorksheetFunction.Max(Range("C:C"))))
>  桁数2 = Len(Str(WorksheetFunction.Max(Range("D:D"))))
>
>に置き換えてみてください。
>
>
>> ↑ここはRange("A")でもいいんですよね?
>>      やっぱり書き込んだほうが良いのでしょうか。
>
>"Range("A65536").End(xlUp).Row"がA列の最終入力行を
>求める決り文句のひとつです。
>
>For i = 1 To Range("A65536").End(xlUp).Row
>
>で「1行目〜A列最終入力行まで繰り返せ」となります。

そうでしたか。確かに見かけたことはあったんですが
ずっと疑問に思ってて勝手に書き換えたりしてました。
結果の空白が減りますね。勉強になります。ありがとうございます。

【6406】Re:セルの内容をテキストに
回答  ポンタ E-MAIL  - 03/6/27(金) 14:10 -

引用なし
パスワード
   以下のコードを実行したとき、メッセージボックスに
表示される値はC列の最大値になっていますか?

Sub test2()
  MsgBox (WorksheetFunction.Max(Range("C:C")))
End Sub

こちでテストしたいので、もし差し支えなかったら、
エラーが出たファイルをメールに添付して送ってもらえませんか?

【6407】Re:セルの内容をテキストに
回答  ポンタ E-MAIL  - 03/6/27(金) 14:23 -

引用なし
パスワード
   Range("E:F") を作業列として使うコードに書き換えてみましたので、
こちらもお試しください。

Sub test()
  Dim objFs As Object, objText As Object
  Dim FileName As String
  Dim MyStr As String
  Dim i As Long
  FileName = "C:\My Documents\test.txt"
  Set objFs = CreateObject("Scripting.FileSystemObject")
  Set objText = objFs.OpenTextFile(FileName, 2, True)
  With Range("C1", Range("C65536").End(xlUp))
    .Offset(0, 2).Resize(, 2).FormulaR1C1 = "=LEN(R[0]C[-2])+1"
  End With
  Range("C65536").End(xlUp).Offset(1, 2).FormulaR1C1 = "=MAX(R1C5:R[-1]C[0])"
  Range("C65536").End(xlUp).Offset(1, 3).FormulaR1C1 = "=MAX(R1C6:R[-1]C[0])"
  For i = 1 To Range("A65536").End(xlUp).Row
    'MyStrにA列の値をセット         MyStr = "0001"
    MyStr = Cells(i, 1).Value
    'MyStrの文末にB列の値を付け足す     MyStr="0001030625"
    MyStr = MyStr & Cells(i, 2).Value
    'Len(Cells(i, 3).Valueで"1000"の文字数を数える = 4
    '桁数1 = 6だから String(2, " ")となる。これは、スペース2文字(" ")を返す
    'よって MyStr=MyStr="0001030625 "となる
    MyStr = MyStr & String(Range("C65536").End(xlUp).Offset(1, 2) _
       - Len(Cells(i, 3).Value), " ")
    'C列の値を付け足す            MyStr="0001030625 1000"
    MyStr = MyStr & Cells(i, 3).Value
    'スペースを付け足す           MyStr="000130625 1000 "
    MyStr = MyStr & String(Range("C65536").End(xlUp).Offset(1, 3) _
      - Len(Cells(i, 4).Value), " ")
    'D列の値を付け足す           MyStr="000130625 1000 50"
    MyStr = MyStr & Cells(i, 4).Value
    'テキストファイルに書き込み
    Call objText.WriteLine(MyStr)
  Next
  objText.Close
  Set objText = Nothing
  Set objFs = Nothing
  Range("E:F").ClearContents
End Sub

【6408】Re:セルの内容をテキストに
質問  あやか  - 03/6/27(金) 14:28 -

引用なし
パスワード
   えーと、えーと;;;
EとFにはエクセルデータになんか入れるんでしょか。


▼ポンタ さん:
>Range("E:F") を作業列として使うコードに書き換えてみましたので、
>こちらもお試しください。
>
>Sub test()
>  Dim objFs As Object, objText As Object
>  Dim FileName As String
>  Dim MyStr As String
>  Dim i As Long
>  FileName = "C:\My Documents\test.txt"
>  Set objFs = CreateObject("Scripting.FileSystemObject")
>  Set objText = objFs.OpenTextFile(FileName, 2, True)
>  With Range("C1", Range("C65536").End(xlUp))
>    .Offset(0, 2).Resize(, 2).FormulaR1C1 = "=LEN(R[0]C[-2])+1"
>  End With
>  Range("C65536").End(xlUp).Offset(1, 2).FormulaR1C1 = "=MAX(R1C5:R[-1]C[0])"
>  Range("C65536").End(xlUp).Offset(1, 3).FormulaR1C1 = "=MAX(R1C6:R[-1]C[0])"
>  For i = 1 To Range("A65536").End(xlUp).Row
>    'MyStrにA列の値をセット         MyStr = "0001"
>    MyStr = Cells(i, 1).Value
>    'MyStrの文末にB列の値を付け足す     MyStr="0001030625"
>    MyStr = MyStr & Cells(i, 2).Value
>    'Len(Cells(i, 3).Valueで"1000"の文字数を数える = 4
>    '桁数1 = 6だから String(2, " ")となる。これは、スペース2文字(" ")を返す
>    'よって MyStr=MyStr="0001030625 "となる
>    MyStr = MyStr & String(Range("C65536").End(xlUp).Offset(1, 2) _
>       - Len(Cells(i, 3).Value), " ")
>    'C列の値を付け足す            MyStr="0001030625 1000"
>    MyStr = MyStr & Cells(i, 3).Value
>    'スペースを付け足す           MyStr="000130625 1000 "
>    MyStr = MyStr & String(Range("C65536").End(xlUp).Offset(1, 3) _
>      - Len(Cells(i, 4).Value), " ")
>    'D列の値を付け足す           MyStr="000130625 1000 50"
>    MyStr = MyStr & Cells(i, 4).Value
>    'テキストファイルに書き込み
>    Call objText.WriteLine(MyStr)
>  Next
>  objText.Close
>  Set objText = Nothing
>  Set objFs = Nothing
>  Range("E:F").ClearContents
>End Sub

【6410】Re:セルの内容をテキストに
回答  ポンタ E-MAIL  - 03/6/27(金) 14:51 -

引用なし
パスワード
   > えーと、えーと;;;
> EとFにはエクセルデータになんか入れるんでしょか。

マクロの実行中に
       E       F
    1 =LEN(C1)+1  =LEN(D1)+1
    2 =LEN(C2)+1  =LEN(D2)+1
    3 =LEN(C3)+1  =LEN(D3)+1
       :       :
       :       :
       :       :
最終行+1 =MAX($E$1:E??) =MAX($F$1:F??)

というような式が入ります。

マクロの最後に式を消去するコードを追加してありますので、
マクロが問題なく終了すれば、式は消えてしまいます。

件数が多いときには ScreenUpdating を設定した方が良いです。
(これでうまくいくようなら、レスします)

【6411】Re:セルの内容をテキストに
お礼  あやか  - 03/6/27(金) 15:00 -

引用なし
パスワード
   式は確かに書き込まれましたが

MyStr = MyStr & String(Range("C65536").End(xlUp).Offset(1, 2) _
       - Len(Cells(i, 3).Value), " ")
で「型が一致しません」、とでました。
といわけで式は消えません。

すみません、わけがわからなくなってきたので
出直します・・・・
とにかくありがとうございました!
ほんとうにご親切にありがとうございました。

▼ポンタ さん:
>> えーと、えーと;;;
>> EとFにはエクセルデータになんか入れるんでしょか。
>
>マクロの実行中に
>       E       F
>    1 =LEN(C1)+1  =LEN(D1)+1
>    2 =LEN(C2)+1  =LEN(D2)+1
>    3 =LEN(C3)+1  =LEN(D3)+1
>       :       :
>       :       :
>       :       :
>最終行+1 =MAX($E$1:E??) =MAX($F$1:F??)
>
>というような式が入ります。
>
>マクロの最後に式を消去するコードを追加してありますので、
>マクロが問題なく終了すれば、式は消えてしまいます。
>
>件数が多いときには ScreenUpdating を設定した方が良いです。
>(これでうまくいくようなら、レスします)

【6418】Re:すみません。全部忘れてください。
回答  Jaka@浅草橋  - 03/6/28(土) 13:29 -

引用なし
パスワード
   こんにちは。
IMacイディゴからです。文字化けしてたらすみません。

最初手作業でやってもらおうとしたのは、Sub ayy4()の実行結果みたいに別シートに関数を書いてもらって、そのシートを別名保存でテキスト保存してもらおうかと思っていたんです。(直接テキストにコピペしても大丈夫かも。)
が、こう言うところ↓を読んでなかったり、
>一部のセルで、金額を表示のしたいのですが桁数が違うとずれてきてしまいます。
>バイト数を制限して表示したいのですが


>書き出したテキスト内容
>030625100050
>03062630000150

>を、
>030625 1000  50
>030626 30000  150
の意味が良くつかめませんでした。

データシートをアクティブにした状態で。
Sub ayy4()
  Dim DatShN As String, ShE As Long
  'DatShN = "data"
  DatShN = ActiveSheet.Name
  ShE = Sheets(DatShN).Range("A65536").End(xlUp).Row
  Worksheets.Add after:=Worksheets(Worksheets.Count)
  Columns(1).Font.Name = "MS ゴシック"
  kansuu = "=" & DatShN & "!C&" & DatShN & "!C[1]&" & "REPT("" "",LEN(MAX(" & _
       DatShN & "!C[2]))-LEN(" & DatShN & "!RC[2]))&" & DatShN & _
       "!RC[2] & REPT("" "",LEN(MAX(" & DatShN & "!C[3]))-LEN(" & DatShN & _
       "!RC[3]))&" & DatShN & "!RC[3]"
  Range("A1:A" & ShE).FormulaR1C1 = kansuu
End Sub


処理内容が、よく解らなかったのに加えて、手動での作成方法も覚えてもらおうかと思いまして。
(処理内容がわかっていれば、コード的にはたいしたことじゃなかったのに。)
下は、全部マクロでやっています。

データシートをアクティブにした状態で。
Sub Zero()
  Dim File_OUT As String, ERow As Long, StA As String, StB As String
  Dim StC As String, StD As String
  Const SP As String = "     "
  ERow = Range("A65536").End(xlUp).Row
  CLM = Len(Application.Max(Columns("C")))
  DLM = Len(Application.Max(Columns("D")))
  File_OUT = ThisWorkbook.Path & "\" & "作ったテキスト.txt"
  Open File_OUT For Output As #1
  For i = 1 To ERow
    StA = Range("A" & i).Text
    StB = Range("B" & i).Text
    StC = Right(SP & Range("C" & i).Text, CLM)
    StD = Right(SP & Range("D" & i).Text, DLM)
    Print #1, StA & StB & StC & StD
  Next
  Close #1
End Sub

【6420】忘れてませんでしたよ〜。
質問  あやか  - 03/6/28(土) 17:12 -

引用なし
パスワード
   Jakaさん、ありがとうございます。
Sub Zero()は一度自分でトライしたコードに
近かったです。全然だめだったので嬉しい^▽^
というか全然違った。
ですがそのまんま貼り付けると「変数が定義されてません」
と出ます。CLM =のところが色反転します。
Sub ayy4()のほうもkansuu =でひっかかってしまいます。

ポンタさんのときはエクセルの値に問題がありましたが
どうなんでしょう?
本当に初心者ですいません;;

▼Jaka@浅草橋 さん:
>こんにちは。
>IMacイディゴからです。文字化けしてたらすみません。
>
>最初手作業でやってもらおうとしたのは、Sub ayy4()の実行結果みたいに別シートに関数を書いてもらって、そのシートを別名保存でテキスト保存してもらおうかと思っていたんです。(直接テキストにコピペしても大丈夫かも。)
>が、こう言うところ↓を読んでなかったり、
>>一部のセルで、金額を表示のしたいのですが桁数が違うとずれてきてしまいます。
>>バイト数を制限して表示したいのですが
>
>
>>書き出したテキスト内容
>>030625100050
>>03062630000150
>
>>を、
>>030625 1000  50
>>030626 30000  150
>の意味が良くつかめませんでした。
>
>データシートをアクティブにした状態で。
>Sub ayy4()
>  Dim DatShN As String, ShE As Long
>  'DatShN = "data"
>  DatShN = ActiveSheet.Name
>  ShE = Sheets(DatShN).Range("A65536").End(xlUp).Row
>  Worksheets.Add after:=Worksheets(Worksheets.Count)
>  Columns(1).Font.Name = "MS ゴシック"
>  kansuu = "=" & DatShN & "!C&" & DatShN & "!C[1]&" & "REPT("" "",LEN(MAX(" & _
>       DatShN & "!C[2]))-LEN(" & DatShN & "!RC[2]))&" & DatShN & _
>       "!RC[2] & REPT("" "",LEN(MAX(" & DatShN & "!C[3]))-LEN(" & DatShN & _
>       "!RC[3]))&" & DatShN & "!RC[3]"
>  Range("A1:A" & ShE).FormulaR1C1 = kansuu
>End Sub
>
>
>処理内容が、よく解らなかったのに加えて、手動での作成方法も覚えてもらおうかと思いまして。
>(処理内容がわかっていれば、コード的にはたいしたことじゃなかったのに。)
>下は、全部マクロでやっています。
>
>データシートをアクティブにした状態で。
>Sub Zero()
>  Dim File_OUT As String, ERow As Long, StA As String, StB As String
>  Dim StC As String, StD As String
>  Const SP As String = "     "
>  ERow = Range("A65536").End(xlUp).Row
>  CLM = Len(Application.Max(Columns("C")))
>  DLM = Len(Application.Max(Columns("D")))
>  File_OUT = ThisWorkbook.Path & "\" & "作ったテキスト.txt"
>  Open File_OUT For Output As #1
>  For i = 1 To ERow
>    StA = Range("A" & i).Text
>    StB = Range("B" & i).Text
>    StC = Right(SP & Range("C" & i).Text, CLM)
>    StD = Right(SP & Range("D" & i).Text, DLM)
>    Print #1, StA & StB & StC & StD
>  Next
>  Close #1
>End Sub

【6422】Re:セルの内容をテキストに
質問  あやか  - 03/6/28(土) 23:13 -

引用なし
パスワード
   ポンタさん、こんばんは。
たびたび申し訳ありませんが教えてください。
よろしくお願いします。
すみません、頼りっぱなしで・・・。

▼ポンタ さん:
>Range("E:F") を作業列として使うコードに書き換えてみましたので、
>こちらもお試しください。
>
>Sub test()
>  Dim objFs As Object, objText As Object
>  Dim FileName As String
>  Dim MyStr As String
>  Dim i As Long
>  FileName = "C:\My Documents\test.txt"
>  Set objFs = CreateObject("Scripting.FileSystemObject")
>  Set objText = objFs.OpenTextFile(FileName, 2, True)
>  With Range("C1", Range("C65536").End(xlUp))
>    .Offset(0, 2).Resize(, 2).FormulaR1C1 = "=LEN(R[0]C[-2])+1"
>  End With
    With Range("D1", Range("D65536").End(xlUp))
      .Offset(0, 2).Resize(, 2).FormulaR1C1 = "=LEN(R[0]C[-2])+2"        End With
    としたとき、

>  Range("C65536").End(xlUp).Offset(1, 2).FormulaR1C1 = "=MAX(R1C5:R[-1]C[0])"
>  Range("C65536").End(xlUp).Offset(1, 3).FormulaR1C1 = "=MAX(R1C6:R[-1]C[0])"

    ↑こちらはどうしたらいいのでしょうか。このあたりの意味を教えてください。     C列最終行からオフセットしてどうしてるのかわからないんです。

>  For i = 1 To Range("A65536").End(xlUp).Row
>    'MyStrにA列の値をセット         MyStr = "0001"
>    MyStr = Cells(i, 1).Value
>    'MyStrの文末にB列の値を付け足す     MyStr="0001030625"
>    MyStr = MyStr & Cells(i, 2).Value
>    'Len(Cells(i, 3).Valueで"1000"の文字数を数える = 4
>    '桁数1 = 6だから String(2, " ")となる。これは、スペース2文字(" ")を返す
>    'よって MyStr=MyStr="0001030625 "となる
>    MyStr = MyStr & String(Range("C65536").End(xlUp).Offset(1, 2) _
>       - Len(Cells(i, 3).Value), " ")
>    'C列の値を付け足す            MyStr="0001030625 1000"
>    MyStr = MyStr & Cells(i, 3).Value
>    'スペースを付け足す           MyStr="000130625 1000 "
>    MyStr = MyStr & String(Range("C65536").End(xlUp).Offset(1, 3) _
>      - Len(Cells(i, 4).Value), " ")
>    'D列の値を付け足す           MyStr="000130625 1000 50"
>    MyStr = MyStr & Cells(i, 4).Value
>    'テキストファイルに書き込み
>    Call objText.WriteLine(MyStr)
>  Next
>  objText.Close
>  Set objText = Nothing
>  Set objFs = Nothing
>  Range("E:F").ClearContents
>End Sub

【6423】Re:セルの内容をテキストに
質問  あやか  - 03/6/28(土) 23:15 -

引用なし
パスワード
   ポンタさん、こんばんは。
もう一つ質問がありました。
小数点の件ですが、今のままでは小数点以下しっかり書き出されますが
値だけを書き出したいときはどうしたらいいですか?

【6424】Re:セルの内容をテキストに
質問  あやか  - 03/6/29(日) 1:32 -

引用なし
パスワード
   ポンタ さん、なんどもごめんなさい。

>  With Range("C1", Range("C65536").End(xlUp))
>    .Offset(0, 2).Resize(, 2).FormulaR1C1 = "=LEN(R[0]C[-2])+1"

   ↑ここもわかってなかったみたいです・・・。
   Resize はC列もD列も同じ処理をするからですよね?
   もし、#6422 で書いたように、D列に違う桁を加えたい場合は
   削除していいんですよね?
   それから、初めはそっかぁ!なんて納得してたのですが
   スペースの書き出しはC列のMAX+1ではなく 11(桁)-C列 
   ってどうやればいいのでしょうか。
   自分なりにはいろいろやってみたのですがうまく行かなくて。
   もう頭いっぱい。はぁ。
   よろしくおねがいします。 

【6428】Re:セルの内容をテキストに
回答  あやか  - 03/6/29(日) 23:33 -

引用なし
パスワード
   自己レスです。
すみません、解決しました。


▼あやか さん:
>ポンタさん、こんばんは。
>たびたび申し訳ありませんが教えてください。
>よろしくお願いします。
>すみません、頼りっぱなしで・・・。
>
>▼ポンタ さん:
>>Range("E:F") を作業列として使うコードに書き換えてみましたので、
>>こちらもお試しください。
>>
>>Sub test()
>>  Dim objFs As Object, objText As Object
>>  Dim FileName As String
>>  Dim MyStr As String
>>  Dim i As Long
>>  FileName = "C:\My Documents\test.txt"
>>  Set objFs = CreateObject("Scripting.FileSystemObject")
>>  Set objText = objFs.OpenTextFile(FileName, 2, True)
>>  With Range("C1", Range("C65536").End(xlUp))
>>    .Offset(0, 2).Resize(, 2).FormulaR1C1 = "=LEN(R[0]C[-2])+1"
>>  End With
>    With Range("D1", Range("D65536").End(xlUp))
>      .Offset(0, 2).Resize(, 2).FormulaR1C1 = "=LEN(R[0]C[-2])+2"        End With
>    としたとき、
>
>>  Range("C65536").End(xlUp).Offset(1, 2).FormulaR1C1 = "=MAX(R1C5:R[-1]C[0])"
>>  Range("C65536").End(xlUp).Offset(1, 3).FormulaR1C1 = "=MAX(R1C6:R[-1]C[0])"
>
>    ↑こちらはどうしたらいいのでしょうか。このあたりの意味を教えてください。     C列最終行からオフセットしてどうしてるのかわからないんです。
>
>>  For i = 1 To Range("A65536").End(xlUp).Row
>>    'MyStrにA列の値をセット         MyStr = "0001"
>>    MyStr = Cells(i, 1).Value
>>    'MyStrの文末にB列の値を付け足す     MyStr="0001030625"
>>    MyStr = MyStr & Cells(i, 2).Value
>>    'Len(Cells(i, 3).Valueで"1000"の文字数を数える = 4
>>    '桁数1 = 6だから String(2, " ")となる。これは、スペース2文字(" ")を返す
>>    'よって MyStr=MyStr="0001030625 "となる
>>    MyStr = MyStr & String(Range("C65536").End(xlUp).Offset(1, 2) _
>>       - Len(Cells(i, 3).Value), " ")
>>    'C列の値を付け足す            MyStr="0001030625 1000"
>>    MyStr = MyStr & Cells(i, 3).Value
>>    'スペースを付け足す           MyStr="000130625 1000 "
>>    MyStr = MyStr & String(Range("C65536").End(xlUp).Offset(1, 3) _
>>      - Len(Cells(i, 4).Value), " ")
>>    'D列の値を付け足す           MyStr="000130625 1000 50"
>>    MyStr = MyStr & Cells(i, 4).Value
>>    'テキストファイルに書き込み
>>    Call objText.WriteLine(MyStr)
>>  Next
>>  objText.Close
>>  Set objText = Nothing
>>  Set objFs = Nothing
>>  Range("E:F").ClearContents
>>End Sub

【6429】Re:セルの内容をテキストに
回答  あやか  - 03/6/29(日) 23:34 -

引用なし
パスワード
   自己レスです。

MyStr = MyStr & String(11 - Len(Cells(i, 7).Value), " ")

で解決しました。
あとは小数点の問題のみ〜!


▼あやか さん:
>ポンタ さん、なんどもごめんなさい。
>
>>  With Range("C1", Range("C65536").End(xlUp))
>>    .Offset(0, 2).Resize(, 2).FormulaR1C1 = "=LEN(R[0]C[-2])+1"
>
>   ↑ここもわかってなかったみたいです・・・。
>   Resize はC列もD列も同じ処理をするからですよね?
>   もし、#6422 で書いたように、D列に違う桁を加えたい場合は
>   削除していいんですよね?
>   それから、初めはそっかぁ!なんて納得してたのですが
>   スペースの書き出しはC列のMAX+1ではなく 11(桁)-C列 
>   ってどうやればいいのでしょうか。
>   自分なりにはいろいろやってみたのですがうまく行かなくて。
>   もう頭いっぱい。はぁ。
>   よろしくおねがいします。

【6441】Re:セルの内容をテキストに
回答  ポンタ  - 03/6/30(月) 9:38 -

引用なし
パスワード
   > 値だけを書き出したいときはどうしたらいいですか?

質問の内容が良く理解できてませんが、
「実際には小数点を含んでいる値なんだけど、表示形式で整数部のみ表示させている」
という事でしょうか?

それなら、Value を Text に書き換えるとうまくいくかもしれません。

Cells(1, 1).Value : A1の値
Cells(1, 1).Text : A1に表示されている文字列
という意味になりますので・・・。

【6442】Re:忘れてませんでしたよ〜。
回答  Jaka  - 03/6/30(月) 10:04 -

引用なし
パスワード
   おはようございます。

>Sub Zero()は一度自分でトライしたコードに近かったです。全然だめだったので嬉しい^▽^というか全然違った。
固定長で何バイトにするのか良く解っていませんので、綿氏のも間違っていると思います。

>「変数が定義されてません」と出ます。
VBEエディタ ツール → オプション で、「変数の宣言を強制する。」にチェックが入っているんですね。エディタの先頭にOption Explicitがついているのですね。

これは、

Dim CLM as long,DLM as long
Dim kansuu as string

と、変数をちゃんと定義してやればいいです。
詳しくは、ヘルプで「変数の宣言」を見ていただければ、載っていると思います。

独り言
一度送った後、左に>がついちゃったんで削除後リトライしたら、「ERROR:同一内容の再投稿は禁止されています。」だって..。ふ、不満だ。
こういう余計な事を書けば良いのかな?

【6448】あ、それと..。
回答  Jaka  - 03/6/30(月) 13:02 -

引用なし
パスワード
   >Const SP As String = "     "
             ↑のスペース全角になっちゃているみたいですが、
             半角スペース10個ぐらい?だったと思います。

綿氏 → 私 です。これ直そうと思ったんですが、直っていなかった。

【6457】Re:あ、それと..。
お礼  あやか  - 03/6/30(月) 22:07 -

引用なし
パスワード
   Jakaさん、お返事ありがとうございます。

一度ポンタさんに教えていただいたコードを
進めてみてからチャレンジさせていただきます。
忘れた頃に質問しても許してください〜^^;
がんばります。

▼Jaka さん:
>>Const SP As String = "     "
>             ↑のスペース全角になっちゃているみたいですが、
>             半角スペース10個ぐらい?だったと思います。
>
>綿氏 → 私 です。これ直そうと思ったんですが、直っていなかった。

【6459】できたぁぁぁぁ!
お礼  あやか  - 03/7/1(火) 19:46 -

引用なし
パスワード
   ポンタさん

大正解です。その通り。
つたない日本語でスミマセンでした。
質問するのも難しいですね。本当に勉強になりました。
ありがとうございました!!!

わたしもいつか「回答」でお答えできる日があれば
他の方にお返しをします。
ありがとうございました。

▼ポンタ さん:
>> 値だけを書き出したいときはどうしたらいいですか?
>
>質問の内容が良く理解できてませんが、
>「実際には小数点を含んでいる値なんだけど、表示形式で整数部のみ表示させている」
>という事でしょうか?
>
>それなら、Value を Text に書き換えるとうまくいくかもしれません。
>
>Cells(1, 1).Value : A1の値
>Cells(1, 1).Text : A1に表示されている文字列
>という意味になりますので・・・。

13228 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free