[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『「ファイル新規作成」[ジャスミン茶] について』（ペンギン男爵）
投稿
[[20160908164905]] 『ファイル新規作成』（ジャスミン茶）
について...
上記投稿を参考にcsv新規作成を行いたいです。
シート1のＡ列にファイル名Ｂ列にアドレスを入れてます。
Ｃ１にＡ列のデータを入れるとＤ1:Ｇ10までに関数が入っていて表示されます。
関数表示されたＤ1:Ｇ10のデータをcsvで保存したいのですが
どうすればいいのでしょうか？
csvは
bk.SaveAs fPath & "\" & c.Value & ".csv"
でいいのかと思いますが、Ｄ1:Ｇ10迄だけをcsvにする修正方法が分かりません。
どなたかご教授ください。
Sub Sample2()
Dim bk As Workbook
Dim c As Range
Dim bPath As String
Dim fPath As String
Dim flag As Boolean
Application.ScreenUpdating = False
bPath = ThisWorkbook.Path
Set bk = Workbooks.Add
With ThisWorkbook.Sheets("Sheet1") '★
For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp)) '★
fPath = bPath & "\" & c.Value
'フォルダの存在チェックとなかった場合の作成
flag = False
If Len(Dir(fPath, vbDirectory)) > 0 Then
If (GetAttr(fPath) And vbDirectory) = vbDirectory Then flag = True
End If
If Not flag Then MkDir fPath
'ブックの書き込み
Application.DisplayAlerts = False
bk.SaveAs fPath & "\" & c.Value & ".xlsx"
Application.DisplayAlerts = True
c.Offset(, 1).Value = fPath
Next
End With
bk.Close False
MsgBox "処理が終了しました"
End Sub
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
一旦、特定範囲だけってのは忘れて、SaveAsのヘルプを読むか、マクロの記録を使って、CSV形式で保存するには、どんな引数が必要か確認してみては?
（もこな２） 2018/05/16(水) 08:44
提示されたコードをどのように理解して、どの部分を流用しようとしているのかわからないですが、
たぶん、
(1)新規ブックを追加する。
(2)Ｄ1:Ｇ10の値を、（1）の1番目のシートのA1セル以降にコピペする
(3)(2)をCSV形式で名前をつけて保存する
って感じで、処理する必要があるのでは？
（もこな２） 2018/05/16(水) 09:04
Sub Sample()
Dim bk As Workbook
Dim c As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set bk = Workbooks.Add
With ThisWorkbook.Sheets("Sheet1") '★SaveAsSaveAsSaveAs
For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp)) '★
bk.SaveAs "g:\test\" & c.Value & ".xlsx"
Next
End With
Application.DisplayAlerts = True
bk.Close False
End Sub
CSVだといったん開いてしまうとゼロが消えてしまうので、D1:D10にまとめて関数表示にして
テキストファイルに保存しようと考えています。（最初の質問と変わってすいません）
記録したところ、下記コードが表示されました。
Sub Macro1()
'
Range("D1:D10").Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ChDir "g:\test"
ActiveWorkbook.SaveAs Filename:="g:\test\a.txt", FileFormat _
:=xlText, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
End Sub
下記コードに書き換えて、テキストファイルは何とか作れるようになりましたが
Ｃ１のセルを変更してD1:D10を表示させているのですがこのコードだと
Ｃ１のセルが変更できません。コピーする前にＡ列のデータを入力する方法を
教えていただけないでしょうか？
Sub Sample3()
Dim bk As Workbook
Dim c As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range("D1:D10").Select '追記
Selection.Copy '追記
Set bk = Workbooks.Add
With ThisWorkbook.Sheets("Sheet1") '★SaveAsSaveAsSaveAs
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False '追記
Application.CutCopyMode = False '追記
For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp)) '★
bk.SaveAs "g:\test\" & c.Value & ".txt", FileFormat:=xlText, CreateBackup:=False '追記
Next
End With
Application.DisplayAlerts = True
bk.Close False
End Sub
宜しくお願いします。
（ペンギン男爵） 2018/05/16(水) 12:07
（１）
Range("D1:D10").Select '追記
Selection.Copy '追記
ここは、Range("D1:D10").Copy とした方がスマートだとおもいます。
（２）
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False '追記
同じことが↑でも言え「bk.Worksheets(1).Range("A1") Paste:=xlPasteValues」なんてほうがスマートに思えます。
（３）
せっかく「With ThisWorkbook.Sheets("Sheet1")」としているのですから、
「Range("D1:D10").Copy」も、この内側に入れて「.Range("D1:D10").Copy」とちゃんとシートを修飾するように直した方がいいんじゃないでしょうか。
（４）
「Application.ScreenUpdating = False」について意味がわかって入れているなら別にいいんですけど、私ならテスト動作したときに想定外の動きをしてても見落としてしまう原因になるので、私なら完成（安定動作が確認されるまで）入れないです。
（５）
SaveAsの引数「FileFormat:=xlText」は、それでいいんでしょうか？
（望む形になったならいいですけど、CSV形式にしたかったんじゃないんでしょうか・・・）
【参考】https://msdn.microsoft.com/ja-jp/vba/excel-vba/articles/xlfileformat-enumeration-excel
コードについては上記のようなところがちょっと気になりました。
次に、追加質問がよくわからないですが、
＞Ｃ１のセルを変更してD1:D10を表示させているのですがこのコードだと
＞Ｃ１のセルが変更できません。コピーする前にＡ列のデータを入力する方法を
＞教えていただけないでしょうか？
であれば、
(1)マクロを動かす前に、手動で変更（入力）する。
(2)マクロの中で、コピペする前に自動で変更（値の設定）を行う。
この、どちらでも処理できると思うんですがどうでしょうか？
（もこな２） 2018/05/16(水) 13:38
この質問はアルバイトの方に勤務時間やお給料の情報が入ったエクセルファイルを作って送っていたんですが
エクセルを持っていない方が多くcsvで送ろうと思い折角だから自動化できないかなと
質問させていただいたのですがテストで作ったものをアルバイトの方へ送ったところ
ゼロが無くなってズレてよく分からないのでやめて欲しいと連絡がありました。
なのでテキストファイルを送ることにしました。
（通りすがりのビギナー） 2018/05/16(水) 16:00
⬆困らせるような質問すいません。
上手く質問できていないようで、申し訳ないです。
Ｃ１にＡ列のデータを入れると、Ｄ1:Ｄ10までにvlookup関数を使って
勤務時間やお給料の情報が表示されるようにしています。
Ｃ１にＡ列のデータを入れた状態でＡ列のファイル名をつけたファイルを自動で作ろうとしています。
このコメント、上のコメントの前に入れようとして切れていました。
前後おかしくなってすいいません。
後、ニックネームがなぜか違う名前で入っていますがペンギン男爵です。
（ペンギン男爵） 2018/05/16(水) 16:13
２）
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False '追記
同じことが↑でも言え「bk.Worksheets(1).Range("A1") Paste:=xlPasteValues」なんてほうがスマートに思えます。
すいません、コンパイルエラーとなるものが表示されました。
（３）
せっかく「With ThisWorkbook.Sheets("Sheet1")」としているのですから、
「Range("D1:D10").Copy」も、この内側に入れて「.Range("D1:D10").Copy」とちゃんとシートを修飾するように直した方がいいんじゃないでしょうか。
内側に入れるとはどうゆう意味でしょうか？
初歩的な質問で申し訳ありません。
ご教授いただけないでしょうか？
（ペンギン男爵） 2018/05/16(水) 19:24
Sub text2()
Dim bk As Workbook
Dim c As Range
Dim r As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set bk = Workbooks.Add
With ThisWorkbook.Sheets("Sheet1") '★SaveAsSaveAsSaveAs
For Each r In Sheet1.Range("A:A") '追記データ用シートのA列にデータがある分だけループ
If r.Value = "" Then '追記A列が空ならループ終了
Exit For
End If
Range("c1").Value = r.Offset(, 0).Value 'データを転記
Range("D1:D10").Copy '追記
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False '追記
'bk.Worksheets(1).Range("A1") Paste:=xlPasteValues '→コンパイルエラーになります
Application.CutCopyMode = False '追記
For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp)) '★
bk.SaveAs "g:\test\" & c.Value & ".txt", FileFormat:=xlText, CreateBackup:=False '追記
Next
End With
Application.DisplayAlerts = True
bk.Close False
End Sub （ペンギン男爵） 2018/05/16(水) 20:00
おっと失礼。肝心要のメソッドを書き忘れてました。
誤 bk.Worksheets(1).Range("A1") Paste:=xlPasteValues
正 bk.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
＞内側に入れるとはどうゆう意味でしょうか？
そういう質問がくるってことは、「With」ってどういう意味で書いてあるかよく解らなかったりしませんか？
もし解らなければ「Withステートメント」という単語をネット検索などで調べてみてください。
一応、参考リンクも紹介
http://officetanaka.net/excel/vba/beginner/16.htm
また、text2について気になる箇所があったのでツッコミ
（１）
If r.Value = "" Then '追記A列が空ならループ終了
Exit For
End If
↑だめじゃないですけど、なんで
For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
から変えたんですか？
（２）
With ThisWorkbook.Sheets("Sheet1") '★SaveAsSaveAsSaveAs
For Each r In Sheet1.Range("A:A") '追記データ用シートのA列にデータがある分だけループ
For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp)) '
Next c
Next r
End With
なんで二重ループにしたんですか？
さらに、二重ループにしたことにより内側の部分で同じこと（同じ名前で同じブックを保存）を何度もやることになるとおもうんですが、思った通りの動作なんでしょうか？
（３）
Application.CutCopyMode = False '追記
前回のツッコミわすれ。
コピーモードを解除したところで次の周回？ですぐにまたコピペするので、ループの外で最後に１回だけやればいいと思います。
（４）
r.Offset(, 0)
これは何をやりたいのかよくわかりません。
ということを踏まえて、たたき台。
（動作テストはしてないのでミスっていたらごめんなさい）
Sub Sample3()
Dim MyRNG As Range
With ThisWorkbook.Worksheets("Sheet1")
For Each MyRNG In .Range(.Range("A1"), .Range("A1").End(xlDown))
.Range("C1").Value = MyRNG.Value
.Range("D1:D10").Copy
With Workbooks.Add
.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
Application.DisplayAlerts = False
.SaveAs _
Filename:="g:\test\" & MyRNG.Value & ".txt", _
FileFormat:=xlText
.Close
Application.DisplayAlerts = True
End With
Next MyRNG
Application.CutCopyMode = False
End With
End Sub
上を「ステップ実行」してみて望みの動作をするか確認して、上手くいくようであれば、どの命令がどのようなことをやっているのか研究してみてください。
（もこな２） 2018/05/17(木) 00:28
私が作成したコードは、こちらにサイトに掲載されているコードを見よう見まねで切りはりしたものでコードの理解はほとんど出来ていません。
どの命令がどのようなことをやっているのか、をどうやって確認するか調べながら(まずそこからなんです)勉強していきますね。
ありがとうございました。
（ペンギン男爵） 2018/05/18(金) 09:16
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.