| |
初めまして。初心者で至らないところもあると思いますが質問させていただきます。
元のデータを入れれば、いろいろな計算を自動で行うブックを作ったのですが、
データが何種類もあるため、データを読み込んで保存するマクロを組みたいと考えました。
今組んだ段階のものは、
まずCSVを読み込む→貼り付けたい位置のセルをクリアする→データをコピーする→
クリアした位置に張り付ける→指定した位置のセルの名前でファイルを新規保存する
です。
しかし、同じCSVデータに複数の種類のものが入ってしまっているため、
１つのデータを読み込んだら自然と分けて保存してくれるようにしたいのです。
（ex: A1〜R272と、A273〜R543をそれぞれ別のブックで保存する）
「貼り付けたい位置のセルをクリアする→データをコピーする→
クリアした位置に張り付ける→指定した位置のセルの名前でファイルを新規保存する」
の部分をfunctionでどうにかしようとしたのですが、うまくいかないため、困っています。
＜作った繰り返しなしの文＞
Sub 円楕円2_Click()
Dim strFileName As String
' オープンするCSVファイルのフォルダを C:\ として
' ファイルオープンのダイアログを開く
ChDir ("C:\")
strFileName = Application.GetOpenFilename("CSVファイル (*.CSV),*.CSV", 1, "ファイルを選択")
If (strFileName <> "False") Then
' ファイル名が存在しない場合は抜ける
If (Trim(Dir(strFileName)) = "") Then
Call MsgBox("ファイルが見つかりません", vbOKOnly, "確認")
Else
'
' コピー先の範囲をクリア
ThisWorkbook.Worksheets("データ入力場所").Range("A3:R273").ClearContents
' 該当CSVファイルを新規BOOKとして読込んで開く
'
' コピーペースト
Workbooks.Open Filename:=strFileName
ActiveSheet.Range("A1:R272").Copy _
Destination:=ThisWorkbook.Worksheets("データ入力場所").Range("A3")
' コピー後、CSVファイルを閉じる
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End If
End If
' book新規保存
Dim セル内容, パス名 As String
セル内容 = Range("B4").Value ' アクティブセルの内容をファイル名として保存。
If セル内容 = "" Then Exit Sub
パス名 = "C:\Users" ' 保存場所
ActiveWorkbook.SaveAs Filename:=パス名 & "\" & セル内容 & ".xlsm"
End Sub
＜試したこと＞
・コピペ部分と保存部分を別々のファンクションで作ってみること
・CSVを閉じる部分を最後に持ってきて、その前の部分をファンクションで作る
→失敗
よろしくお願いいたします。
|
|
Iｂ（初心者）
- 13/5/13(月) 11:32 -
