ネットが遅くてイライラしてない!?

こんにちは。
当方マクロ初心者で、教本を片手にマクロを組んでいるレベルです。
宜しければご回答お願いします。

質問はタイトルにあるように、
「読み込んだcsvファイルの名前を別名保存のファイル名に使いたい」
ということです。

マクロ有効のエクセルファイル(abc.xlsm)に、csvファイル(123.csv)を取り込む
※GetOpenFilenameというマクロでcsvファイルを取り込んでいます(マクロボタンを設置)

取り込んだcsvデータで集計等の作業をする

作業が終わったマクロ有効エクセルファイル(abc.xlsm)を「別名をつけて保存」する
※この時、保存ダイアログボックスに読み込んだcsvファイルの名前が自動で付与される(123.xlsm)
ようにしたいです。

なお「別名をつけて保存」はエクセルファイル(abc.xlsm)上にマクロ実行用のボタンを設置して使用する予定です。
(ボタンで実行させるのはエクセルに不慣れな方も使用する為です)

説明が下手でやりたいことがうまく伝わっていないかもしれませんが、、、
よろしくご教授くださいませ。

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

A 回答 (3件)

1. とあるマクロ付きブック (仮に macro.xlsm) がある。

こいつは CSV を何らか処理するためのブックである。
2. とある csv ファイル (仮に 20150101.csv) がある。
3. macro.xlsm から 20150101.csv を開き、CSV に書かれているデータを読み取って macro.xlsm 自体のシート上に何らかの転記処理をする。
4. 処理が終わったら macro.xlsm 自身を別名保存する。 ファイル名は読み込み元の CSV ファイルにならって 20150101.xlsm にしたい。
5. 以後、次の CSV を処理する際も macro.xlsm を使って処理を行っていく。
という感じでしょうか。

CSV ファイルを開く際、CSV ファイルの名前を変数にとっておく。
→ 標準モジュールの public 変数にでも入れておく。
→ "名前を付けて保存" の処理と同じ標準モジュールにあるのなら public じゃなくて private な変数でも良い。
または
CSV ファイルを開く際に CSV ファイルを Workbook オブジェクトとして参照しているのなら、その変数の Name プロパティに格納されている。

以下のような変数に CSV ファイルのファイル名 (パスでも可能) を突っ込むと拡張子なしのファイル名を取得できます。
ex.) hoge.csv やら d:\test\hoge.csv やら \\server\aaa\hoge.csv → "hoge"

Function GetCsvBasename(aCsvFileName As String) As String
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  Dim baseName As String
  baseName = fso.GetBaseName(aCsvFileName)
  
  GetCsvBasename = baseName
End Function


ただし xlsm ファイルを SaveAs で保存する際は FileFormat 引数に "xlOpenXMLWorkbookMacroEnabled" を指定しなくてはなりません。。

ThisWorkbook.SaveAs "csv ファイル名", xlOpenXMLWorkbookMacroEnabled
    • good
    • 0
この回答へのお礼

ありがとうございました!

お礼日時:2015/09/18 13:36

こんにちは。



>説明が下手でやりたいことがうまく伝わっていないかもしれませんが、、、
というよりも、やはり内容的には製作依頼になってしまいますね。
ただ、誰が作ったものであれ、他人の作ったものですと「なくて七癖」で違いが出てきて、「これは何?」とか、不本意なものがあるかもしれません。一応、事前に、ご知らせさせていただます。

・以下のマクロの特徴
拡張子の選択は、一応、ご要望通り、'xlsm' は選択できますが、もしない場合はそうではない場合は、標準の 'xlsx' に戻ってしまいます。基本的には、'xlsx' で良いのではないかと思います。

自動化のため、最初のファイルの選択(GetOpenFileName)以外の、保存時のダイアログ型はやめました。
>csvファイルの名前が自動で付与される(123.xlsm)
もし同名のファイルがあった場合は、自動的に枝番が付きます。言い換えると、既存のファイルの上書きをしないということにしました。

>マクロ有効のエクセルファイル(abc.xlsm)に、csvファイル(123.csv)を取り込む
これ自体は変わりませんが、取り込んだCSVファイルは、残す・残さないの選択は可能です。

 '.Copy 'シートを残す場合
 .Move '追加したシートを分離

現行では、分離-残さないという選定になっています。

'//
Sub CSVImport()
 Dim fn As Variant
 Dim outFn As Variant
 Dim fNum As Integer
 Dim i As Long, buf As Variant
 Dim TextLine As String
 Dim myArray
 Dim lngCount As Long
 Dim BaseFn As String, orgBaseFn As String '基幹ファイル名
 Dim strFilter As String
 Dim myPath As String
 Dim fFormat As Integer
 
 '拡張子の選択
 '拡張子の選択
 Dim EXTE As String: EXTE = ".xlsm"
 If StrComp(EXTE, ".xlsm", vbTextCompare) = 0 Then
  fFormat = xlOpenXMLWorkbookMacroEnabled '52
 Else
  fFormat = xlOpenXMLWorkbook '51
  EXTE = ".xlsx"
 End If

 On Error GoTo ErrHandler
 'ファイル選択ダイアログ
 fn = Application.GetOpenFilename("CSVファイル(*.csv),*.csv", Title:="ファイル選択")
 If VarType(fn) = vbBoolean Then Exit Sub
 'ベースファイル名を取得
 myPath = Left(fn, InStrRev(fn, "\"))
 outFn = Dir(fn)
 BaseFn = Left(outFn, InStrRev(outFn, ".") - 1)
 orgBaseFn = BaseFn '変更用のために確保
 'ファイル・テキストインポート
 fNum = FreeFile()
 Open fn For Input As #fNum
 With ActiveWorkbook
  .Worksheets.Add After:=Worksheets(Worksheets.Count)
 End With
 
 With ActiveSheet
  Application.ScreenUpdating = False
  Do While Not EOF(fNum)
   Line Input #fNum, TextLine
   If Len(TextLine) > 1 Then
    lngCount = lngCount + 1
    myArray = Split(TextLine, ",") 'デリミタは、「,」
    .Cells(lngCount, 1).Resize(, UBound(myArray) + 1).Value = myArray
   End If
  Loop
  Close #fNum
  Application.ScreenUpdating = True
  '.Copy 'シートを残す場合
  .Move '追加したシートを分離
 End With
 With ActiveWorkbook
  '出力ファイル名
  'ファイル名の重複を避ける
  buf = Dir(myPath & BaseFn & EXTE)
  Do Until buf = ""
   i = i + 1
   BaseFn = orgBaseFn & "_" & CStr(i)
   buf = Dir(myPath & BaseFn & EXTE)
  Loop
  .SaveAs myPath & BaseFn, fFormat
  .Close False
 End With
 MsgBox BaseFn & EXTE & "の保存終了", vbInformation
 Exit Sub
ErrHandler:
 MsgBox Err.Number & ": " & Err.Description
End Sub
'///
    • good
    • 0

やりたいことが見えない部分があります。


取り込んだCSV・・・は
abc.xlsmのシートにコピペしているの?
今のコードは公開できないのかな。
ということでファイル名の取り出しだけです。

Sub sample()
Dim FilePath As String, FileName As String, v As Variant, i As Integer

FilePath = Application.GetOpenFilename("CSV Files (*.csv), *.csv")
v = Split(FilePath, "\")
For i = LBound(v) To UBound(v) '以下3行イミディエイトウィンドウでの確認用
Debug.Print i & "__" & v(i)
Next

FileName = v(UBound(v)) '拡張子を含んだファイル名
Debug.Print "あり", FileName

FileName = Left(v(UBound(v)), InStrRev(v(UBound(v)), ".") - 1) '拡張子含まず
Debug.Print "なし", FileName
End Sub
    • good
    • 0

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

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

このQ&Aを見た人はこんなQ&Aも見ています

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

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

Qエクセルマクロで任意のファイル名をつけて保存したい

 エクセルVBAについての質問です。
 エクセルのマクロで、Aというファイルを開いて、そのうち必要なワークシートだけを抽出し、新しいブックに移動し、その新しいブックを新しいブックのsheet1のセルC2の文字列をファイル名として保存するようなマクロをくみたいと思っています。
 ファイルを開いて必要なワークシートだけを抽出し、新しいブックに移動するところまではできましたが、新しいブックのセルC2の文字列をファイル名として保存することができません。FNを変数として宣言して、C2の文字列を代入し、FNをファイル名として保存しようとすると、ファイルにFNという名前が付いてしまいます。どうすれば、C2の文字列をファイル名として保存できるのでしょうか。なお、保存するフォルダはc:\変換ファイル\6月です。どなたか教えてください。よろしくお願いします。

Aベストアンサー

FNを文字列として扱っていませんか?以下でどうでしょう?


Sub 保存()

Dim FN As String
FN = Range("C2")
ActiveWorkbook.SaveAs Filename:="C:\変換ファイル\6月\" & FN & ".xls"
End Sub

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

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

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QcsvをVBAを使ってエクセル形式で保存したい

タイトルのとおりなのですが、csvをVBAを使ってエクセル形式で保存したいのですが、その際ひとつ条件がありまして作成するエクセルファイルをcsvと同じ名前にしたいと思っています。

 csvのファイル名は都度変わってしまうため私の現在の知識ではVBAを作成することができません。

 教えて下さい。よろしくお願いします。

Aベストアンサー

もしエクセル形式で保存するフォルダがCSV形式のファイルのフォルダと一緒でよいなら

Sub SVasNormal()
ActiveWorkbook.SaveAs FileFormat:=xlNormal
End Sub

でCSVと同名のエクセルファイルが作成されます。

パスを変更するなら
 ActiveWorkbook.Name
で「ファイル名を取得」→「任意のパスを加える」→「拡張子のcsvをxlsに置換」→「SaveAsメソッドで書き込み」で良いと思います

QEXCEL|csvで保存→開くcsvを閉じる

xlsファイルからcsvで書き出したいのですが、書き出し後そのcsvファイルが開いてしまいます。この時保存をしてしまうと、セルが勝手に日付書式に読み込まれたまま保存されてしまいます。
これを回避するために、開いたcsvをそのまま保存せずに閉じたいのです。これはvbaでなんとかなるのでしょうか?
もしかしたら設定でできるのかも知れませんがどうしても見つかりませんでした。よろしくお願いします。

Aベストアンサー

こんにちは。No.3補足へのレスです。
>別のブックにコードを保存しておいて、
は○ですが
>書き出しをしたいxlsファイルからその別ファイルのマクロを呼び出して実行する
が少し意味が違うかもしれません。混乱させてしまってごめんなさい。

ActiveWorkbookの名前がhoge.xlsだとします。
これにマクロコードを入れて、hoge.xlsをhoge.csvとして保存するような設定だと
コードの修正などした後に、hoge.xlsを上書き保存せずに実行すると
hoge.csvにはVBAコードは保存できないですから、
コード修正が反映されないままになります。
また、VBAに保護をかけたりするとエラーとなります。
ですので、ただ単に、マクロのブックとデータのブックは分けたほうが良いですよ。
という意味でした。

運用の詳細が不明なのでなんとも言えないところですが、
VBAコードを含んだ、複数シートを持つxlsブックをcsvファイルとして保存する事は
あまりないような気もしましたから。
そういう点を考慮するならば

Sub csvで書き出し2()
ActiveSheet.Copy '■追加
With ActiveWorkbook
.SaveAs Filename:="C:\Documents and Settings\○○○\デスクトップ\hoge.csv" _
, FileFormat:=xlCSV
.Close SaveChanges:=False
End With
End Sub

という感じで、目的のシート『だけ』を一旦コピーしてcsvファイルとして保存するように
変更されたほうが良いかもしれませんね。

こんにちは。No.3補足へのレスです。
>別のブックにコードを保存しておいて、
は○ですが
>書き出しをしたいxlsファイルからその別ファイルのマクロを呼び出して実行する
が少し意味が違うかもしれません。混乱させてしまってごめんなさい。

ActiveWorkbookの名前がhoge.xlsだとします。
これにマクロコードを入れて、hoge.xlsをhoge.csvとして保存するような設定だと
コードの修正などした後に、hoge.xlsを上書き保存せずに実行すると
hoge.csvにはVBAコードは保存できないですから、
コード修正が反映...続きを読む

QVBAでフォルダ内の全てのcsvファイルからコピペ

マクロ超初心者です。

フォルダ内のすべてのcvsファイル(500程度)の5列目(500行程度)を新規ファイルの1列目から順にコピーしていきたいのです。

ちなみに元のcvsファイルのシート数は一つだけでシート名には全てファイル名が付いています。
(つまり全てのファイルのシート名が異なる)

見よう見真似で似たようなマクロから意味もわからないまま
つぎはぎして下記作りましたが
やっぱり動きません。

どなたか詳しい方どうかよろしくお願いします。


Sub Sample()
Const FolderPath As String = "C:\data"
Dim objFSO As Object
Dim objBook As Object
Dim lngRow As Long

Application.ScreenUpdating = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objBook In objFSO.GetFolder(FolderPath).Files
lngcolumn = ThisWorkbook.Sheets("sheet1").Range("A" & Columns.Count).End(xlToRight).Column + 1
Workbooks.Open objBook.Path
With ActiveWorkbook
.Worksheets(1).Column("5").Copy ThisWorkbook.Sheets("sheet1").End(xlToRight).Offset(0, 1)
.Close
End With
Next

Set objFSO = Nothing

Application.ScreenUpdating = True

End Sub

マクロ超初心者です。

フォルダ内のすべてのcvsファイル(500程度)の5列目(500行程度)を新規ファイルの1列目から順にコピーしていきたいのです。

ちなみに元のcvsファイルのシート数は一つだけでシート名には全てファイル名が付いています。
(つまり全てのファイルのシート名が異なる)

見よう見真似で似たようなマクロから意味もわからないまま
つぎはぎして下記作りましたが
やっぱり動きません。

どなたか詳しい方どうかよろしくお願いします。


Sub Sample()
Const FolderPath As String = ...続きを読む

Aベストアンサー

私なら、こんな感じで作ります。

Sub test()
Const FolderPath As String = "C:\data"
Dim Filename As String
Dim Sh0 As Worksheet, Sh As Worksheet
Dim c As Long

Set Sh0 = ActiveSheet
Filename = Dir(FolderPath & "\*.csv")
Do Until Filename = ""
c = c + 1
Set Sh = Workbooks.Open(FolderPath & "\" & Filename).Sheets(1)
Sh.Columns(5).Copy Sh0.Columns(c)
Application.DisplayAlerts = False
Sh.Parent.Close
Application.DisplayAlerts = True
Filename = Dir()
Loop
End Sub

私なら、こんな感じで作ります。

Sub test()
Const FolderPath As String = "C:\data"
Dim Filename As String
Dim Sh0 As Worksheet, Sh As Worksheet
Dim c As Long

Set Sh0 = ActiveSheet
Filename = Dir(FolderPath & "\*.csv")
Do Until Filename = ""
c = c + 1
Set Sh = Workbooks.Open(FolderPath & "\" & Filename).Sheets(1)
Sh.Columns(5).Copy Sh0.Columns(c)
Application.DisplayAlerts = False
Sh.Parent.Close
...続きを読む

Qエクセル マクロで指定フォルダを開く

エクセルにて
指定フォルダを開く、マクロがあれば教えて頂けないでしょうか。
よろしくお願いいたします。

Aベストアンサー

こんにちは。

こういうものですか?
開くフォルダを変えたいときは targ に与えるパスを変更します。

Sub OpenFolders()
Dim targ As String
targ = "C:\"
Shell "C:\Windows\Explorer.exe " & targ, vbNormalFocus
End Sub

QExcel VBAで同じフォルダ内のファイルを開くには?

Windows2000、Excel2000を使用しています。

「経理」というフォルダに「見積」「請求」の2つのExcelファイルがあります。
「見積」から「請求」を開くマクロを作りたいのですが、どうすればいいでしょうか?
「経理」フォルダは場所が変わることがあるので、パスをどうすれば良いかがわからず苦しんでいます。
VBAはまったくの素人で、本を見ながら挑戦しているのですがうまくできないのです。

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

Aベストアンサー

必ず「経理」というフォルダに「見積」「請求」の2つのExcelファイルがあると仮定。

以下ならどうでしょう?

フォルダごと移動されても上記のお約束があれば大丈夫と思います。
以下の記述は「見積」に記述してください。



Sub BookOpen()
Workbooks.Open Filename:=ThisWorkbook.Path & "\請求.xls"
End Sub

QVBA シートのボタン名を変更したい

こんにちは。
Excelのマクロを作成しているのですが、
ユーザーフォームではなく、
シートにあるフォームのボタンの名前を変更したいのです。
どうしたら変更できるのでしょうか。
わかるかたいらっしゃいましたら、教えてください。

よろしくお願いします。

Aベストアンサー

#2です。

> Application.callerで取得するボタン名を
> 変更したいのです。

了解です。
ボタンを選択します。そうすると、左上の「名前ボックス」に「ボタン1」とか表示されますね?
そこで名前ボックスの中を変更し、Enterキーです。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング