- ベストアンサー
エクセルＶＢＡで住所録からテキストファイルを作成
piroin654の回答
- piroin654
- ベストアンサー率75% (692/917)
>新しくはどのような名前のファイルと中身になるのか の、中身が補足になかったので、単にフォルダと 空のファイルという感じで、回答します。 コードが長いので、説明とコードを分けて 掲載します。 四つのプロシージャを使っています。 testMain、cmdMkDir、cmdMakeChuFile、cmdMakeShoFile です。 testMainを実行します。一つにすると長くなるのと、 cmdMakeChuFile、cmdMakeShoFile は、実際にhtmlファイルを作成するプロシージャ ですので、分離しておいたほうが編集がしやすく なるのでこのようにしています。 cmdMkDir は、フォルダ作成のプロシージャで、ここでは 大分類のフォルダを作成するために使用します。 各プロシージャの説明、特にtestMainについては 長くなるので、コードにコメントを入れています。 [説明] testMainについて。 testMainはADOを使用していますので、コード表でADOに チェックが入っているか確認してください。参照設定で、 Microsoft ActiveX Data Objects xx Library となっています。xxはバージョンによってちがいますが、 2.1のような数字です。 testMainは、ADOとDictionaryを使ってデータをSheetから抜き出して います。つまり、Sheetのデータの集まりをデータベースの テーブルに見立ててデータの検索、抽出をしています。 コードはほとんどデータベースの操作をVBAでしているので、 一般的なExcelのコードとは違和感があるかもしれません。 本来ならばDictionaryは使わなくても済むのですが、 ExcelのバージョンやOSなどの使用環境によって使えない 機能があるので、あえてDictionaryを使います。 [説明] cmdMakeChuFile、cmdMakeShoFile について。 この二つは、testMainで検索して抽出した該当するフォルダの 場所とファイル名(この場合は、該当する中分類名)を 受け取って、必要なhtmlファイルを作成するものです。 中分類と小分類のファイルの内容が同じならば、一つ でもいいのですが、一応わけておきました。 なお、各htmlに表示する内容が不明なので、パスと ファイル名を表示しておきました。 SheetからのデータはADOを使って能率よく取り出せるのですが、 どのようなデータを表示するのかがわかれば、と思います。 そのあたりはどうでしょう。 [説明] cmdMkDir について。 cmdMkDirはtestMainで名寄せをした大分類の各データを 受け取って大分類のフォルダを作成しています。 必要ならば、中分類のフォルダも各大分類のフォルダ に作成することもこのプロシージャを使用すれば できます。 [説明] testMainの処理の流れ "SELECT 大分類 FROM [Sheet1$] GROUP BY 大分類" というSQL文で名寄せした大分類をもとに、フォルダを 作成し、 "SELECT * FROM [Sheet1$]" というSQL文で取得したSheetのデータを検索し、 同じ大分類をもつ中分類を抽出し、中分類ファイル を作成し、同じ大分類、中分類をもつ小分類を "SELECT * FROM [Sheet1$]" というSQL文で取得したSheetのデータを検索し 小分類ファイルを作成します。 これが、処理の流れの概要です。
関連するQ&A
- エクセルＶＢＡでリストを仕分けしてファイル出力
会社リストからＨＴＭＬファイルを作成しています。 １つの地域で１つのファイルにしています。 地域によっては会社数が多くなってきたので、 ２０社ごとにファイルを別にして出力したいと考えております。 tokyo tokyo2 tokyo3 tokyo4 ・ ・ ・ Ｇ列のファイル名を２０社ごとに変換するには 以下のソースをどのように改良すれば良いのか、ご教授願います。 Sub HTMLファイル出力() Dim myPath As String Dim i As Long myPath = Environ("USERPROFILE") & "\Desktop\Hoge\" Range("A:G").Sort Key1:=Range("G2"), Header:=xlYes, MatchCase:=False, _ Orientation:=xlTopToBottom For i = 2 To Range("G1").End(xlDown).Row If Range("G" & i).Text <> Range("G" & i - 1).Text Then Open myPath & Range("G" & i).Text & ".html" For Output As #1 Print #1, "<!DOCTYPE html>" & vbNewLine _ & "<html lang=""en"">" & vbNewLine _ & "<body>" & vbNewLine _ & "<div class=""span3"" id=""sidebar"">" & vbNewLine End If Print #1, "<div class=""widget"">" & vbNewLine _ & "<h4 class=""widgetTitle"">" & Range("A" & i).Text & "</h4>" & vbNewLine _ & "<ul><li>" & Range("B" & i).Text & "</li>" & vbNewLine _ & "<li>" & Range("C" & i).Text & "</li>" & vbNewLine _ & "<li>" & Range("D" & i).Text & "</li>" & vbNewLine _ & "<li>" & Range("E" & i).Text & "</li></ul></div>" & vbNewLine If Range("G" & i).Text <> Range("G" & i + 1).Text Then Print #1, "</div>" & vbNewLine & "</body>" & vbNewLine & "</html>" Close #1 End If Next End Sub
- ベストアンサー
- Visual Basic
- テキストファイルをエクセルに移すマクロのことで？
以前、複数のテキストファイルをエクセルに移すマクロを教えてもらったのですが、 以下マクロですと、フォルダのパスを指定しないといけません。 今回教えてもらいたいのは、フォルダのパスを指定しなくてもよい方法です。 どういう事かと言うと、仮にディスクトップにフォルダがあるとします。 そのフォルダの中には、マクロが入っているエクセルシートとテキストが入っているフォルダです。 つまり、そのフォルダ内だけで、処理をしたいと考えています。 また、フォルダ名は、その時によって異なります。 今までは、以下の方法を使っていたのですが、ちょっと使いにくいと感じています。 申し訳ありませんが、どなたか教えていただけないでしょうか？ Sub Macro() Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim FolderPath As String 'ここのアドレスをファイルが格納されているフォルダのパスに変えてください FolderPath = "C:\Users\・・・" Dim myFile As Object Dim i As Long i = 2 Dim myFolder As Object For Each myFolder In fso.GetFolder(FolderPath).SubFolders For Each myFile In fso.GetFolder(myFolder).Files Cells(i, 4).Value = myFolder Cells(i, 1).Value = myFile.Name Cells(i, 7).Value = fso.OpenTextFile(myFile.Path).ReadAll() i = i + 1 Next Next End Sub Private Sub CommandButton1_Click() End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBAでブックのデータをテキストファイルに
エクセル「Excel2003」ブックのデータを仕分けしてテキストファイルを作成する。 住所録（全国一覧表：シート１枚に記載）があります。 住所ごとにデータを分けて、個別のテキストファイルを作成する ※テキストファイルのファイル名は地域コード（英数字）にする。 tokyo.html ※テキストファイルの種類は、HTMLファイル ※住所録の項目は、 会社名、住所、電話、FAX、担当者、地域コード の６個 ※HTMLファイルに表示させるのは地域コードを除いた５項目 ※以下は、HTMLファイルの例になります。 <!DOCTYPE html> <html lang="en"> <body> <div class="span3" id="sidebar"> <div class="widget"> <h4 class="widgetTitle">会社名1</h4> <ul><li>住所1</li> <li>電話番号1</li> <li>ファックス1</li> <li>担当者1</li></ul></div> <div class="widget"> <h4 class="widgetTitle">会社名2</h4> <ul><li>住所2</li> <li>電話番号2</li> <li>ファックス2</li> <li>担当者2</li></ul></div> <div class="widget"> <h4 class="widgetTitle">会社名3</h4> <ul><li>住所3</li> <li>電話番号3</li> <li>ファックス3</li> <li>担当者3</li></ul></div> <div class="widget"> <h4 class="widgetTitle">会社名4</h4> <ul><li>住所4</li> <li>電話番号4</li> <li>ファックス4</li> <li>担当者4</li></ul></div> <div class="widget"> <h4 class="widgetTitle">会社名5</h4> <ul><li>住所5</li> <li>電話番号5</li> <li>ファックス5</li> <li>担当者5</li></ul></div> <div class="widget"> <h4 class="widgetTitle">会社名6</h4> <ul><li>住所6</li> <li>電話番号6</li> <li>ファックス6</li> <li>担当者6</li></ul></div> </div> </body> </html>
- ベストアンサー
- Visual Basic
- VBAでtextファイルを作成
マクロ・VBA初心者です。 ご教授お願いします！！ 経費精算のExcelデータを画像のような「"",]で区切ったテキストファイルを作成するマクロを作りたいと考えてます。 完成イメージ：マクロのボタンを押すとテキストファイルの形でフォルダに作成される。もしくは、マクロボタンを押すとテキストファイルの形で区切ったものが表示されるものを作りたいです。 ＊経費精算データに関してA列からX列まであり、集計データにより列にデータを埋めていく作業が入っております。なので、A列からX1列まででデータが記入されている範囲で集計できるようにしたいと考えております。 現在は、勉強しつつ組み立てた結果、 CSVのExcelファイルをフォルダの中に作成できるようになりました。 （コードは下記に記載します） ただ、テキストファイルが作れるコードができていないのが問題です。 このコードをどのように変えればよいのか？ もしくは、別のコードで出来るようならば教えていただけると嬉しく思います。 宜しくお願いします。 ______________________________ 〈コード〉 Option Explicit Sub ExcelファイルCSV形式作成() '変数宣言 Dim filePath As String Dim i As Long Dim maxRow As Long Dim fileNo As Integer '初期値設定 filePath = ActiveWorkbook.Path & "\経費計算エクセル（CSV保存）.csv" maxRow = Range("A1").End(xlDown).Row '最終行取得 fileNo = FreeFile 'FreeFile関数で使用可能なファイル番号取得 'ファイル開く Open filePath For Output As #fileNo '最終行までループ For i = 1 To maxRow '列の数は決め打ち Write #fileNo, Cells(i, 1), Cells(i, 2), Cells(i, 3), Cells(i, 4), Cells(i, 5), Cells(i, 6); Cells(i, 7), Cells(i, 8), Cells(i, 9); Cells(i, 10), Cells(i, 11), Cells(i, 12); Cells(i, 13), Cells(i, 14), Cells(i, 15); Cells(i, 16), Cells(i, 17), Cells(i, 18); Cells(i, 19), Cells(i, 20), Cells(i, 21); Cells(i, 22), Cells(i, 23), Cells(i, 24) Next i 'ファイル閉じる Close #fileNo End Sub ＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿ 以上です。 本当に困ってます。よろしくお願します。
- ベストアンサー
- Visual Basic
- エクセルVBAでファイル作成
エクセルVBAで、データをフィルタで抽出し、別なBOOKの指定シートに転記し、名前をつけて保存したいのです。一応、下記のコードでテストは成功しました。 しかし下記コードでは1回ごとにデータの転記先を開かなくてはなりません。 処理する件数が多いので、できればいちいち新たに開き直さなくともよい方法はないでしょうか？ 最初から開いておいて、転記後名前をつけて保存すると、開いていたファイルが閉じてしまい、うまくいきません。 別BOOKでなく別シートに転記して、そのシートをMoveして別ファイル保存ならわかるのですが、今回はどうしても別BOOKに転記しなければなりません。 よろしくお願いします。 Option Explicit Sub データ分割転記() Dim myPth As String, fname As String Dim myRng As Range, myC As Range Dim i As Long, x As Long Dim wb(2) As Workbook Dim ws As Worksheet Dim t As Single t = Timer Set wb(0) = ThisWorkbook myPth = wb(0).Path With wb(0).Sheets("Key") Set myRng = .Range("A2", .Range("A2").End(xlDown)) 'KeyData End With For Each myC In myRng Application.EnableEvents = False Set wb(1) = Workbooks.Open(Filename:=myPth & "\20150806TEST.xlsm") Set ws = wb(1).Sheets("List") With wb(0).Sheets("DATA") .Range("A1:J1").AutoFilter Field:=4, Criteria1:=myC.Value .Range("A2", .Range("A2").SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy ws.Range("A9") .ShowAllData End With With ws x = .Cells(Rows.Count, "A").End(xlUp).Row myC.Offset(, 2).Value = x '行数確認 .Range("A9").Value = 1 If x > 9 Then .Range("A9").AutoFill Destination:=.Range("A9:A" & x), Type:=xlFillSeries '連番 End If End With wb(1).SaveAs Filename:=myPth & "\作成ファイル\" & myC.Value & ".xlsm" wb(1).Close (False) Application.EnableEvents = True i = i + 1 Next MsgBox i & "件を完了" _ & vbCrLf & Timer - t & " Sec." End Sub ＊Application.EnableEvents = False を使っているのば別BOOKが持つイベントマクロを作動させないためです。
- ベストアンサー
- Excel（エクセル）
- エクセルからテキストファイルはきだし
エクセルのひとつのシートの内容をテキスト形式で吐き出すマクロを教えてください。 エクセルでHTMLメルマガの商品名や金額を編集できるようにしたいのですが、その編集後のファイルをテキストで出すマクロのVBAの書き方を教えてください。 現在、以下で書いておりますがエクセルの中にある「$」が消えてしまいます。＄が消えないような書き方を教えてください。また、""が余分についてしまう書き方は避けたいです。よろしくお願い致します。 Sub test() Dim StrFN As String StrFN = ActiveWorkbook.Path & "\data.txt" Dim i As Long, LngLoop As Long Dim IntFlNo As Integer Worksheets("HTML").Activate LngLoop = Range("a65536").End(xlUp).Row IntFlNo = FreeFile Open StrFN For Output As #IntFlNo For i = 1 To LngLoop Print #IntFlNo, Cells(i, 1) Next i Close #IntFlNo End Sub
- ベストアンサー
- Visual Basic
- エクセル、マクロの事で・・・？（２）
昨日、質問した者です。 http://okwave.jp/qa/q7374907.html 以下のマクロを教えてもらいました。 昨日の質問では、エクセルのＡ列にフォルダ名、Ｂ列にファイル名、それぞれフォルダとtxtを出力するマクロを教えてもらいました。 そこでもう一つ質問があるのですが、C列の内容をテキストに出力する場合はどうすればいいのでしょうか？ 度々の質問で申し訳ありませんが、教えていただけないでしょうか？ よろしくお願いします。 sub macro1() dim myPath as string dim h as range on error resume next mypath = thisworkbook.path worksheets(1).select for each h in range("A1:A" & range("A65536").end(xlup).row) mkdir mypath & "\" & h.value open mypath & "\" & h.value & "\" & h.offset(0, 1).value & ".txt" for output as #1 close #1 next end sub
- ベストアンサー
- オフィス系ソフト
- VBでテキストファイルを作成して，また消したい
VisualBasicでDLLファイルを呼び出して実行したいのですが， その際に，テキストに一度引数を入れたいと思っています． しかし，不要になれば，そのつどプログラムの中でテキストファイルを削除したいと思っています． テキスト作成は Open App.Path + "\新規作成.txt" For Output Access Write As 1 mystring = "ByVal ImaFile As String" Print #1, mystring Close #1 でできたのですが， テキストを削除する方法を教えてください． HELPには Sub Manip_Files() Dim fso As New FileSystemObject, txtfile As TextStream, fil1 As File, fil2 As File Set txtfile = fso.CreateTextFile("c:\testfile.txt", True) MsgBox "ファイルを削除します。" ' 現在の位置でファイルのハンドルを取得します。 Set fil1 = fso.GetFile("c:\tmp\testfile.txt") Set fil2 = fso.GetFile("c:\temp\testfile.txt") ' ファイルを削除します。 fil1.Delete fil2.Delete MsgBox "完了しました。" End Sub という方法が載っているのですが， 最初のFileSystemObjectでひっかかります． 参照設定が足らないと思われるのですが， 何を加えたらいいのでしょうか． 教えてください．
- ベストアンサー
- Visual Basic
- vba ファイルの移動について
フォルダAの中にあるたくさんのpdfファイルの中から、 ファイル名の頭文字３つがE列に記載した「aaa」だったら フォルダBに移動させるという内容にしたいです。 ネット検索などで、近いものを作成しましたが（下に貼り付け）、 下から４行目、「fso.moveFile FolderA & "\" & fileName, FolderB & "\" & fileName」で 「実行時エラー'53' ファイルが見つかりません。」 とエラーが出てしまいます。 どの様に書き直せばよいのでしょうか？ どなたかご存じでしたら、ぜひお教え下さい。 よろしくお願いします。 エクセル2010を使用しています。 Sub CheckAndMoveFiles() Dim FolderA As String Dim FolderB As String FolderA = Range("D1").Value FolderB = Range("B2").Value Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim ws As Worksheet Set ws = ActiveSheet Dim lastRow As Long lastRow = ws.Range("E" & Rows.Count).End(xlUp).Row Dim r As Long Dim fileName As String For r = 1 To lastRow If ws.Cells(r, "E").Value <> "" Then fileName = ws.Cells(r, "E").Value dFileName = Dir(FolderA & "\" & Left(fileName, 3) & "*.pdf") Do While dFileName <> "" dFileName = Dir() Loop fso.moveFile FolderA & "\" & fileName, FolderB & "\" & fileName 'ここでストップ End If Next End Sub
- ベストアンサー
- Excel（エクセル）
- VBAでCSVファイルを読み込もうとしていますが、
VBAでCSVファイルを読み込もうとしていますが、 「ファイルが見つかりません」とエラーが表示されます。 どのように対処していいのかわかりません。 教えてくください。 Sub readCsv() Dim csvFile As String Dim ch As Integer Dim csvStr As String Dim str() As String Dim i As Integer Set ShellApp = CreateObject("Shell.Application") Set oFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1) targetFolder = oFolder.Items.Item.Path Set fso = CreateObject("Scripting.FileSystemObject") Set fileList = fso.GetFolder(targetFolder).Files For Each file In fileList csvFile = file.Name ch = FreeFile Open csvFile For Input As #ch i = 1 Do While Not EOF(1) Line Input #ch, csvStr Close #ch str = Split(csvStr, ",") Range(Cells(i, 1), Cells(i, UBound(str) + 1)) = str i = i + 1 Loop Next End Sub
- ベストアンサー
- Visual Basic