• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:エクセルVBAで住所録からテキストファイルを作成)

エクセルVBAで住所録からテキストファイルを作成

piroin654の回答

  • piroin654
  • ベストアンサー率75% (692/917)
回答No.1

会社名      住所     大分類   中分類   小分類 A病院    北海道札幌市   hokkaido  hokkaido1  hokkaido1A B大学病院  北海道旭川市   hokkaido  hokkaido2  hokkaido2B C大学病院  東京都文京区   tokyo    tokyo1    tokyo1A D市立病院  東京都清瀬市   tokyo    tokyo2    tokyo2A E道立病院  北海道函館市   hokkaido  hokkaido3  hokkaido3C F大学病院  東京都目黒区   tokyo    tokyo3    tokyo3C 質問より少しフィールドを省略していますが、 たとえば上記のようなデータがシートにあるとして、 具体的には、どのようなデータが入ったファイルを 作成しようとしているのでしょうか? >新)大分類の名前のフォルダを作成して、 >  そのフォルダの中に該当する分だけの「中分類のファイル」を作成 >  同じフォルダの中に該当する分だけの「小分類のファイル」を作成 大分類のフォルダ以外のファイルの中身が分かりづらいのですが。 VBAの中分類HTMLソース()では、 Sapporo.html  Asahikawa.html  Tokyo.html  Kiyose.html というファイルが出来て、会社名、住所などがそれぞれに列記されていましたが、 新しくはどのような名前のファイルと中身になるのかが分かりづらいので、 そのあたりを差し支えない程度に詳しく。 たとえば、地図サイトの住所検索のようなものなのか、そのあたりも含めて。

oshiete100goo
質問者

お礼

ご回答ありがとうございます。説明不足で申し訳ございません。 記載いただいた例のデータの場合 hokkaidoのフォルダを作成してその中に hokkaido01.html hokkaido02.html hokkaido03.html hokkaido1A.html hokkaido2B.html hokkaido3C.html の6つのファイル tokyoのフォルダを作成してその中に tokyo1.html tokyo2.html tokyo3.html tokyo1A.html tokyo2A.html tokyo3C.html の6つのファイル を入れるようにしたいと思っています。 いまのVBAでは、予め作成しておいたフォルダに 作成したファイルを格納していくようになっています。 これを住所欄をもとにして hokkaidoとかaomoriのフォルダを作り、 その中にhokkaido01.htmlとhokkaido1A.htmlのファイルを 入れるようにしたいと思っています。

関連するQ&A

  • エクセルVBAでリストを仕分けしてファイル出力

    会社リストからHTMLファイルを作成しています。 1つの地域で1つのファイルにしています。 地域によっては会社数が多くなってきたので、 20社ごとにファイルを別にして出力したいと考えております。 tokyo tokyo2 tokyo3 tokyo4  ・  ・  ・ G列のファイル名を20社ごとに変換するには 以下のソースをどのように改良すれば良いのか、ご教授願います。 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

  • テキストファイルをエクセルに移すマクロのことで?

    以前、複数のテキストファイルをエクセルに移すマクロを教えてもらったのですが、 以下マクロですと、フォルダのパスを指定しないといけません。 今回教えてもらいたいのは、フォルダのパスを指定しなくてもよい方法です。 どういう事かと言うと、仮にディスクトップにフォルダがあるとします。 そのフォルダの中には、マクロが入っているエクセルシートとテキストが入っているフォルダです。 つまり、そのフォルダ内だけで、処理をしたいと考えています。 また、フォルダ名は、その時によって異なります。 今までは、以下の方法を使っていたのですが、ちょっと使いにくいと感じています。 申し訳ありませんが、どなたか教えていただけないでしょうか? 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」ブックのデータを仕分けしてテキストファイルを作成する。 住所録(全国一覧表:シート1枚に記載)があります。 住所ごとにデータを分けて、個別のテキストファイルを作成する ※テキストファイルのファイル名は地域コード(英数字)にする。  tokyo.html ※テキストファイルの種類は、HTMLファイル ※住所録の項目は、  会社名、住所、電話、FAX、担当者、地域コード の6個 ※HTMLファイルに表示させるのは地域コードを除いた5項目 ※以下は、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>

  • 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 ______________________________________ 以上です。 本当に困ってます。よろしくお願します。

  • エクセル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が持つイベントマクロを作動させないためです。

  • エクセルからテキストファイルはきだし

    エクセルのひとつのシートの内容をテキスト形式で吐き出すマクロを教えてください。 エクセルで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

  • エクセル、マクロの事で・・・?(2)

    昨日、質問した者です。 http://okwave.jp/qa/q7374907.html 以下のマクロを教えてもらいました。 昨日の質問では、エクセルのA列にフォルダ名、B列にファイル名、それぞれフォルダと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でひっかかります. 参照設定が足らないと思われるのですが, 何を加えたらいいのでしょうか. 教えてください.

  • vba ファイルの移動について

    フォルダAの中にあるたくさんのpdfファイルの中から、 ファイル名の頭文字3つがE列に記載した「aaa」だったら フォルダBに移動させるという内容にしたいです。 ネット検索などで、近いものを作成しましたが(下に貼り付け)、 下から4行目、「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

  • 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