AIと戦って、あなたの人生のリスク診断 >>

A2からB5までデータが入っている時に、
このデータのみ(A1~B1まで除く)をテキスト
ファイル(スペース区切り)(.prnファイル)
で保存しようとすれば
どのようにすればよろしいのでしょうか。

SaveAsを使うとデータの取り出し方法がわからず、
Writeを使うのはCSVファイルにする方法しか分からない
状態です。

よろしくお願いします。

このQ&Aに関連する最新のQ&A

A 回答 (3件)

補足について、


>最後の行までとんでいってしまいます。

変数Output_Sheetは定義されているでしょうか。定義してなければOn Error GoToで最後まで飛びます。
また、スペース区切りのファイルにならないと思いますので手を加えてみました。On Error GoToの処理も少し手を加えています。

後半部分です。
  For lRowNumb = 5 To lLastRowNumb
    For nColumNumb = 1 To 24
      sData = Cells(lRowNumb, nColumNumb).Value
      If nColumNumb < 24 Then '修正
        Print #nFrn, sData & " "; '修正
      Else '修正
        Print #nFrn, sData '修正
      End If '修正
    Next nColumNumb
  Next lRowNumb

  Close #nFrn

  Exit Sub '追加

HandleError:
エラー処理?
    • good
    • 0
この回答へのお礼

おかげさまで解決いたしました。
本当に、回答ありがとうございました。

お礼日時:2001/10/07 18:34

こんなかんじですか。



項目(A,B,..)が増えたら、そちらもFor-Nextで、変数で変えるといいです。
Cells(縦,横)で指定します。
がんばってくださいね。
'-----------------------

Sub saveCells()
'■ PRNファイル出力 -----

Dim iFrn As Integer
Dim loFF As Long
Dim strFname As String
Dim strA As String
Dim strB As String

'保存ファイル名(任意)
strFname = "SaveCells.prn"

'データのあるシート名を指定する
Worksheets("Sheet1").Activate

'保存ファイルを開く
iFrn = FreeFile(0)
Open strFname For Output As #iFrn

'1項目ごとに処理をする
For loFF = 2 To 5

'セルのデータを文字列でもらう
strA = Cells(loFF, 1).Value
strB = Cells(loFF, 2).Value

'ファイルに出力(半角空白区切り)
Print #iFrn, strA & " " & strB

Next loFF

Close #iFrn

MsgBox "保存終了しました" & vbCrLf & " File: " & strFname

End Sub
'----------------
では

この回答への補足

回答ありがとうございます。

一度教えていただいた方法でやってみました。

コードは以下になります。
(実際はA5~X5以下をテキストファイルにしようとして
います。)

On Error GoTo HandleError

Dim nFrn As Integer
Dim lRowNumb As Long
Dim sFilename As String
Dim sData As String
Dim lLastRowNumb As Long
Dim nColumNumb As Integer

'最終入力ライン抽出
Worksheets(Output_Sheet).Cells(65536, 1).End(xlUp).Select
lLastRowNumb = Selection.Row

sFilename = "C:\Usr\output.prn"
Worksheets(Output_Sheet).Activate

nFrn = FreeFile(0)
Open sFilename For Output As #nFrn

For lRowNumb = 5 To lLastRowNumb
For nColumNumb = 1 To 24

sData = Cells(lRowNumb, nColumNumb).Value

Print #nFrn, sData & " "

Next nColumNumb
Next lRowNumb

Close #nFrn


HandleError:

なぜか、最終入力ラインを抽出する
Worksheets(Output_Sheet).Cells(65536, 1).End(xlUp).Select
から次の行を読まずに最後の行までとんでいってしまいます。

何かコードに問題があるのでしょうか?

補足日時:2001/10/05 13:16
    • good
    • 0

1.セル範囲A2~B5までを「新しいブック・単一のシート」にコピーする。


  (1)シート名を右クリック。
  (2)「移動またはコピー」で移動先ブック名を「新しいブック」にする。
2.ブック(シート)を「名前を付けて保存する」。
  (1)タイプを「PRN」とする。
  (2)ファイル名をダブルコーテーションで囲めば拡張子も指定可能。

上記をマクロで記録してみて、コードを読んでください。

> データの取り出し方法がわからず

DIM nFile as integer
OPEN パス+ファイル名 FOR INPUT AS #nFile
のようなコマンドを書けば読めます。

ヘルプの「OPEN」でも見てください。

> Writeを使うのはCSVファイルにする方法しか分からない
Print #xxをみてください。

この回答への補足

教えていただいた方法でやってみました。

On Error GoTo HandleError

Sheets(Output_Sheet).Select
Sheets(Output_Sheet).Copy
ActiveWorkbook.Rows("1:4").Select
ActiveWorkbook.Selection.Delete Shift:=xlUp
ActiveWorkbook.SaveAs Filename:="C:\USR\output.prn", FileFormat:= _
xlTextPrinter, CreateBackup:=False

HandleError:

現在は、一旦シートをコピーして
不必要な行(1行目~4行目)を削除してそれを保存する、
という方法にしております。

しかし、なぜかActiveWorkbook.Rows("1:4").Selectの後に、
Deleteする行(ActiveWorkbook.Selection.Delete Shift:=xlUp)から下
をとばしてプログラムの最後までいってしまいます。
コードに何か問題でもあるのでしょうか?

補足日時:2001/10/05 13:56
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QExcelシートをテキスト形式で保存するマクロを作成しているのですが、

Excelシートをテキスト形式で保存するマクロを作成しているのですが、
Excelでは1行なのに、出来上がったテキストでは途中で改行されてしまいます。
ExcelにはAからDEまでデータが入力されています。
途中で改行されてしまう原因は何なのでしょうか。

ご回答よろしくお願い致します。

Aベストアンサー

可能性としては以下など考えられます。

1)セル内で改行している箇所はありませんか?

 その場合は、セル内改行文字列 vbLf あるいは Chr(10) を
 事前に置換で消すなどすれば対応できるかと思います。

2)スペース区切りテキストの.prnファイルでの保存ではないですか?

 その場合、1行あたりの文字数に制限があります。240文字です。
 ↓こちらを参考に対応してください。
 『Excel で書式付きテキスト (.prn) の文字数が 1 行あたり 240 文字に制限される』
 http://support.microsoft.com/kb/249885/ja
 またはスペース区切りじゃなくタブ区切りのテキスト形式にするとか、
 固定長ファイルなら↓こちらを参考にするとか。
 http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_055.html

QEXCELファイルのカレントフォルダを取得するには?

EXCELファイルのカレントフォルダを取得するには?

C:\経理\予算.xls

D:\2005年度\予算.xls

EXCEL97ファイルがあります。

VBAで
  カレントフォルダ名
(C:\経理\,D:\2005年度\)
を取得する事は可能でしょうか?

CURDIRでは上手い方法が見つかりませんでした。

Aベストアンサー

こんばんは。
Excel97 でも、同じですね。以下で試してみてください。

Sub test()
'このブックのパス
a = ThisWorkbook.Path
'アクティブブックのパス
b = ActiveWorkbook.Path
'Excelで設定されたデフォルトパス
c = Application.DefaultFilePath
'カレントディレクトリ
d = CurDir
MsgBox "このブックのパス   : " & a & Chr(13) & _
   "アクティブブックのパス: " & b & Chr(13) & _
   "デフォルトパス    : " & c & Chr(13) & _
   "カレントディレクトリ : " & d & Chr(13)
End Sub

QEXCELをTEXTに一括変換出来ませんか?

複数のEXCEL(複数のシートあり)を一括してテキスト化する手段又はツールはありませんか?若しくは一個のEXCELでもかまいません。量があるのでいちいち開いてTEXTセーブするのがつらくなってきました。

Aベストアンサー

私も、マクロやVBAは得意ではないので、あまり良いコードではないですが、とりあえずこれでできると思います。


エクセルを起動(Book1になってると思います)- Alt + F11 - Microsoft Visual Basic・・・ という画面が表示されたら
挿入 - 標準モジュール - 大きな白いスペースのところに下記のコードをコピペ。
Microsoft Visual Basic・・・を閉じてBook1にもどり念のため適当な場所に保存して下さい。

'------------この下からコピー--------------
Sub test()
Dim wb As Workbook
Dim st As Worksheet
Dim wbname As String
Dim stname As String

For Each wb In Workbooks
wb.Activate
If wb.Name <> ThisWorkbook.Name Then
wbname = Left$(wb.Name, Len(wb.Name) - 4)
For Each st In Worksheets
st.Activate
stname = st.Name
wb.SaveAs Filename:="C:\" & wbname & "_" & stname & ".txt", FileFormat:=xlText, CreateBackup:=False
Next
wb.Close savechanges:=False
End If
Next
End Sub
'------------この上まで-----------------------

そのあと、テキスト化したいエクセルをすべて開きます。
(先ほど作成したブックも開いた状態です)
メニューバーの ツール - マクロ -マクロ ー 表示されているマクロ(複数ある場合は、「TEST」が含まれているもの)
を選択し、実行ボタンをクリックします。
保存先は「C:\」(Cドライブ)です。

私も、マクロやVBAは得意ではないので、あまり良いコードではないですが、とりあえずこれでできると思います。


エクセルを起動(Book1になってると思います)- Alt + F11 - Microsoft Visual Basic・・・ という画面が表示されたら
挿入 - 標準モジュール - 大きな白いスペースのところに下記のコードをコピペ。
Microsoft Visual Basic・・・を閉じてBook1にもどり念のため適当な場所に保存して下さい。

'------------この下からコピー--------------
Sub test()
Dim wb As Workbook
...続きを読む

QVBAでメモ帳にコピペをしたいのですが…

おせわになります。
excelで、たとえば、A1~A3のセルをコピーして、メモ帳に貼り付けるというVBAを作りたいのですが、うまくいかないので、教えていただけないでしょうか。
Range("A1:A3").Select
Selection.Copy
a& = Shell("notepad.exe", vbNormalFocus)
AppActivate ("無題 - メモ帳")
…ここまでは書けてるんですが…が…

Aベストアンサー

こんばんは。

本格的には、APIで書くところでしょうけれども、簡単な方法では、以下のようなものがあります。おそらく、#1 さんのご指摘のように、私も環境によってかなり違ったような記憶があります。Excelから、クリップボードに入ったものが、外に排出しないという問題だったか、前面に来ないのだっか、何かあったように思います。(APIでは可能ですが、これらをまともに書くと、ものすごいコードになってしまいます)

以下は、XP でしか試していません。

Sub TestSendText()
  Dim ret As Long
  ActiveSheet.Range("A1:A3").Copy
  ret = Shell("Notepad.Exe", vbNormalFocus)
  AppActivate ("無題 - メモ帳")
  CreateObject("Wscript.Shell").SendKeys "^v"
End Sub

なお、リテラル値以外に「a&」という書き方は、あまりVBAではしません。間違いではありませんが。

こんばんは。

本格的には、APIで書くところでしょうけれども、簡単な方法では、以下のようなものがあります。おそらく、#1 さんのご指摘のように、私も環境によってかなり違ったような記憶があります。Excelから、クリップボードに入ったものが、外に排出しないという問題だったか、前面に来ないのだっか、何かあったように思います。(APIでは可能ですが、これらをまともに書くと、ものすごいコードになってしまいます)

以下は、XP でしか試していません。

Sub TestSendText()
  Dim ret As Long
 ...続きを読む

Qエクセルで特定の行を削除したいのですが。

エクセルで特定の行を一発で削除したいのですが、やり方がわかりません。
どなたか詳しい方お教えいただけませんでしょうか?

やりたいことは、B列に、特定の文字が有れば、その行全部を削除して上方向にシフトしていきたいのですが、マクロとかを使うのでしょうか?
宜しくお願いいたします。

Aベストアンサー

マクロを使う別の方法です。
XXXの部分を特定の文字に置きかえて実行してください。
また、「特定の文字があれば」というのが、その文字列を含む、というのでなくセルの値がその文字列ならば、というのであれば、LookAt:=xlPart の部分を LookAt:=xlWhole に書き換えてください。

Sub DelLines()
  Dim R As Range
  Do
    Set R = ActiveSheet.Range("B:B").Find(What:="XXX", LookAt:=xlPart)
    If R Is Nothing Then Exit Sub
    R.EntireRow.Delete
  Loop
End Sub

QExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。

以下のようなプログラムをVBAで作成したいと考えています。

A1のセルに値があれば、その値をB1に返す。
次にA2のセルに値があれば、その値をB2に返す。
A行に値がある一番下のセルまで同じようなことをさせたいと考えています。

VBAは初心者です。
どなかた宜しくお願い致します。

Aベストアンサー

#2さんと似たものですが・・・・参考にしてください。

Sub test001()
Dim i As Long
i = 1
Do While Cells(i, 1) <> ""
Cells(i, 2) = Cells(i, 1)
i = i + 1
Loop
End Sub

QエクセルVBA テキストに出力、名前を付けて保存

エクセルVBA テキストに出力、名前を付けて保存
   A  B   C   D
1  aa  bb  cc  =A1&B1&C1
2  dd  ee  ff  =A2&B2&C2
3  gg  hh  ii  =A3&B3&C3


上記エクセルのD列の内容(セルA1~C3が連続したもの)を1行毎にテキストに出力し、
B列の内容をファイル名にしてテキストファイルを多量に自動生成したいのです。

上記エクセルのように3行なら下記の3つのファイルが生成されるといったVBAがほしいのです。

ファイル名がbb.txtで、テキストの内容はaabbcc。
ファイル名がee.txtで、テキストの内容はddeeff。
ファイル名がhh.txtで、テキストの内容はgghhii。


実際は数千行あるので、数千ファイルを一気に生成させたいのです。

どうぞよろしくお願いいたします。

Aベストアンサー

1>1  aa  bb  cc  =A1&B1&C1 

2>実際は数千行あるので、数千ファイルを一気に生成させたいのです。

3>ファイル名がbb.txtで、テキストの内容はaabbcc。

ちょっと説明不足のような気もしますが、このままで出力したら、必ず、同じものが出てきてしまいます。それを考慮して作れば、以下のようになります。

'//
Sub TestMacro()
 Dim i As Long, k As Variant, j As Long
 Dim fn As String
 Dim mPath As String
 Dim rng As Range, ar As Variant
 Dim buf As String
 Set rng = Range("A1", Cells(Rows.Count, 1).End(xlUp).Offset(, 2))
 
 mPath = CurDir 'パスを決める(CurDir は、カレントディレクトリ)
 
 ar = rng.Value
 For i = 1 To rng.Rows.Count
  fn = ar(i, 2) & ".txt"
  Do Until Dir(mPath & "\" & fn) = ""
   k = Val(k) + 1
   j = InStr(1, fn, "(", 1)
   If j > 0 Then
    fn = Mid(fn, 1, j - 1) & "(" & k & ")" & ".txt"
   Else
    fn = Replace(fn, ".txt", "", , , 1) & "(" & k & ")" & ".txt"
   End If
  Loop
  Open fn For Output As #1
  Print #1, ar(i, 1) & ar(i, 2) & ar(i, 3)
  Close #1
  k = ""
 Next
 If Len(buf) > 2 Then
  MsgBox Mid(buf, 2) & vbCrLf & "重複のため保存は省かれました。"
 Else
  MsgBox mPath & "に出力されました。"
 End If
End Sub

1>1  aa  bb  cc  =A1&B1&C1 

2>実際は数千行あるので、数千ファイルを一気に生成させたいのです。

3>ファイル名がbb.txtで、テキストの内容はaabbcc。

ちょっと説明不足のような気もしますが、このままで出力したら、必ず、同じものが出てきてしまいます。それを考慮して作れば、以下のようになります。

'//
Sub TestMacro()
 Dim i As Long, k As Variant, j As Long
 Dim fn As String
 Dim mPath As String
 Dim rng As Range, ar As Variant
 Dim buf As String
 Set rng = Range("A1", C...続きを読む


人気Q&Aランキング