エクセルマクロで外部ファイルを開きたい

質問

エクセルマクロで外部ファイルを開きたい
エクセルのマクロをまだ詳しく知らないため、
ここで教えていただき一連の作業の最後にデータをクリップボードに
納めるところまでのマクロを作っていただきました。
そしてこのクリップされたデータをエディタソフト(Em-Editor)をその都度起動して張り付けています。
ついては使用中のマクロの中に外部ファイル（エディタ）を呼び出すところまでできれば
都合がいいのですが、手元にある解説書などを見ると
ファイルの呼び出しマクロはエクセルのワークブックのことしか記述してありません。
外部ファイル（エディタ・新規）をマクロで呼び出すことは可能でしょうか。
WindowsXP-SP3/Excel2003/

回答No.31

DOUGLAS_ · ベストアンサー

【お別れの言葉】

１）Excel の「マクロ」と「ＶＢＡ（Visual Basic for Application）」とは、似て否なるものですが、掲示板などでは、ほぼ同じ扱いになっています。

２）ＶＢＡ を編集する画面を ＶＢＥ（Visual Basic Editor）と呼び、Excel の ウィンドウ から、[ツール(T)] - [マクロ(M)] - [Visual Basic Editor(V)]（[Alt] + [F11] ）で起動します。

３）掲示板などから マクロ を コピペ する場合には、ＶＢＥ で [挿入(I)] - [標準モジュール(M)] から行ないます。

４）ＶＢＥ の コードウィンドウ 内に コメント を書くときには、先頭に アポストロフィ（'）を付けます。
　他の言語で コメントアウト するときに ダブルスラッシュ（//）を付けるので、「'//」を付ける場合も多いようです。

５）(３) の時点で現われた コードウィンドウ に「Option Explicit」という文字が入っている場合は、「変数」・「定数」を宣言しなければ エラー になります。
　逆の言い方をすれば、「変数が定義されていません。」という エラー が出る場合には、初心者の内は、この「Option Explicit」を コメントアウト するか削除すれば ＯＫ です。

６）コード に書かれた言葉の意味が分からないときには、分からない言葉に カーソル を当て、[F1] キー を押下すると、その言葉のヘルプ（[ヘルプ(H)] - [Microsoft Visual Basic ヘルプ(H)]）が現われます。
　ただし、自分で定義した変数以外でも、ヘルプ の出ない言葉がありますので、このような場合には、その言葉を キーワード に ＷＥＢ検索しましょう。

７）ＶＢＥ で マクロ を実行する時に、[F5] キー を押下する（[実行(R)] - [Sub/ユーザーフォームの実行]）と、カーソル の置かれたところに書いてある 、Sub プロシージャ が一気に実行されます。
　Sub プロシージャ とは、「Sub ～～()」～「End Sub」までのひとかたまり（マクロ の １単位）の コード で、１つの 標準モジュール 内に 複数の プロシージャ を記載できます。

８）マクロ を一気に実行せず、途中で止めたいときには、その場所で [F9] キー を押下して、ブレークポイント を設定（[デバッグ(D)] - [ブレークポイントの設定/解除(T)]）します。

９）マクロ を １行ずつ実行したい場合には、[F8] キー を１回押すごとに、１行の ステートメント が実行される ステップ イン デバッグ（[デバッグ(D)] - [ステップイン(I)]）を行ないます。
　このとき、ＶＢＥ と Excel の ウィンドウ を並べて ステップ イン デバッグ すると、なお、デバッグ しやすいかと存じます。

10）ステップ イン デバッグ するときに、[表示(V)] - [ローカル ウィンドウ(S)] で ローカルウィンドウ を開いておくと、宣言された「変数」の値の移り変わりを１行ごとに確かめることができるので、どこで不具合が発生しているのか掴むことができます。
　型宣言されていない変数の場合には「型」も表示してくれるので、型宣言の参考になります。

11）宣言された「変数」以外の、例えば、「ActiveCell.Row」などの値の移り変わりを見たいときには、「ActiveCell.Row」という文字が書かれた範囲を マウス でなぞって（または、[Shift] + [←・→]）反転し、[右クリック] - [ウォッチ式の追加(A)...] = [ウォッチ式の追加] ダイアログ - [OK] し、ウォッチ ウィンドウを開いて（[表示(V)] - [ウォッチ ウィンドウ(H)]）おくと便利です。

12）コード の中に
Debug.Print ActiveCell.Row
と書いておくことによって、その行での「ActiveCell.Row」の値を イミディエイト ウィンドウ（[Ctrl] + [G] または、[表示(V)] - [イミディエイト ウィンドウ(I)]）に吐き出し、後で確認することができます。

13）マクロ の デバッグ中に、イミディエイト ウィンドウ に
? ActiveCell.Row
と書いて [Enter] すると、その時点での「ActiveCell.Row」の値を表示してくれます。
　また、
Range("A1").Select
と書いて [Enter] すると、１行 マクロ を実行することもできます。

【では、(^.^)/~~~】

お礼

重ねて貴重な知識を与えていただき、ありがとうございました。
手元にVBAの書籍はあるものの、なかなかとりつきにくく
こうして実際の作業の中で、具体的なコメントをいただくと
とてもわかりやすく思います。
今後とも今回の経験を元に研鑽したいと思っております。
本当に長い間ありがとうございました。

回答No.30

DOUGLAS_

●No26「お礼」について
＞26はWEBからの貼り付け、27～28は集計作業と書き出し
＞26を使用したら25のふたつのマクロの実行は不要
　以上２件は、その通りです。
----------------
＞他のチャンネルは若干ソースフォームが異なるため
＞この条件はあてはまりません。

●No25「お礼」に
＞例外はありません。
とお答えいただきましたので、テッキリ
＞Ａ列に「：～／」という文字列が含まれない行は タイトル行 には、なり得ない
と思い込んでいました。
----------------
＞Ａ列に「：～／」という文字列が含まれない行は タイトル行 には、なり得ない
＞これはch9-2に限っています。他のチャンネルは
＞・・・・・・この条件はあてはまりません。
　これと、
＞したがって、今回の作業のジャンルは・・・
＞選択メニューは省略してよろしいかと思います。
とが、「したがって」という接続詞で繋がれている意味合いが解りません。

　「：～／」という文字列は「ch9-2に限」られているけれども、「今回の作業のジャンルは」「ch9-2」の「4.歌謡＆演歌」ですので、別に問題はない、という意味でしょうか？
----------------
＞選択メニューは省略してよろしい

myURL = InputBox("オープンするジャンルを番号で入力してください。" & vbCrLf & vbCrLf & _
から
ここにサイトのＵＲＬを書く。
までを、

　myURL = "0062/0062" & Format(Split(myDate, "/")(0) * 1, "00") & _
　　Format(Split(myDate, "/")(1) * 1, "00")

だけに差し替えてください。
----------------
　ここで一つお詫びを申しておきます。
　先ず、用心していたつもりだったのですが、Visual Basic Editor（ＶＢＥ）から コピペ する際、ヘマ をして、ＵＲＬ を伏せ字にするのを忘れておりました。大変、失礼いたしました。
----------------
　それと、今、気付いたのですが、ＶＢＥ で「ts」を「objTS」に一斉置換したため、数ヶ所、おかしなことになっております。
　まぁ、もう関係ありませんが、「"10.j -HITS"」が「"10.j -HIobjTS"」になってますね。
　その他に、「xlCellTypeConstanobjTS」を「xlCellTypeConstants」に、３ヶ所ある「ClearContenobjTS」を「ClearContents」に直してください。
----------------
＞このプロジェクトのプロパティ&メゾットはサポート外
　恐らく、上記の置換 ミス のせいだと思われますので、直してください。
----------------
＞なお、L列のタイトル欄に数字が出ないよう関数を次のように直しました
　この件は、マクロ を書く際の考慮に入れておりません。

--------------------------------

●No27「お礼」について
＞最初の頃の追記タイプに比べるとまったく楽な作業です。
　気に入っていただけたようで幸いです。苦労して書いた甲斐があります。
----------------
>自分の知識がないためほかのアイデアが考えつかず
　「知識」だけではなくて、「アイデア」を募集するような気持でご質問になればいいのではないでしょうか？
----------------
＞エクセルのマクロは、今回初めて手がけたものです。

　大変失礼ながら、「その程度」の スキル で、よくぞここまで付いて来られたものだと感服いたします。
　noro6857 さん、大した方ですね。

--------------------------------

●No28「お礼」について
＞「同一名ファィルの存在による上書き可か別か」の警告
＞「同一名ファィルがあるときは重複防止の付帯番号をつけて処理」

　警告による場合分けは煩雑になりますので、後者で。

'ファイルを作成

の前に、

　　　i = 0
　　　Do While objFSO.FileExists(strFullPath)
　　　　i = i + 1
　　　　strFullPath = strSaveFol & strFileName & "_" & Format(i, "00") & ".txt"
　　　Loop

を追加してください。

　２つ目のファイルから末尾に「_01」・「_02」・「_03」・・・ という連番が付されます。

お礼

＞例外はありません。
とお答えいただきましたので、テッキリ

表現方法が不足だったのかもしれません。
例題も含めて9-2chだけのソースを意識していましたので、例外はないと言ったのですが、
ジャンル選択メニューが入っていたので、他の内容を見たらまちまちのフォームのようなので
あわてて否定したわけです。（11-1chなどは別な作業はしているので内容は知ってますが）

>　「：～／」という文字列は「ch9-2に限」られているけれども、「今回の作業のジャンルは」「ch9-2」の「4.歌謡＆演歌」ですので、別に問題はない、という意味でしょうか？

そのとおりです。他のchはこのような作業をしていませんので9-2chで使えれば問題はないわけです。
大変失礼しました。

その他はそれぞれ修正してこのあと動作確認をしてみたいと思います。
ありがとうございました。

補足

WEB貼り付け、書き出し（重複ファィルでの枝番も含めて）ともすべてバッチリうまくゆきました。
所詮趣味の域を出ませんが、毎日行う必要のある作業なのでとても助かります。
本当に長い間とりかかってくださり、ありがとうございました。
感謝しつくせません。
とりあえず、特に再コメントがなければ締め切りたいと思っています。

また機会がありましたらお世話になることがあるかもしれませんが
その節はこれに懲りずによろしくお願いします。

回答No.29

DOUGLAS_

また、やっちゃぃました。

Sub Group_for_each_Title_Line()

の コード の中で

'データの書き込み

の下にある

　　　　　If Cells(j, Mid("RQPOMN", i, 1)).Text <> "" Then _
　　　　　objTS.WriteLine Cells(j, Mid("RQPOMN", i, 1)).Text

を

　　　　　If Cells(j, Mid(strCols, i, 1)).Text <> "" Then _
　　　　　objTS.WriteLine Cells(j, Mid(strCols, i, 1)).Text

に書き換えてください。

--------------------------------

　なお、今日はちょっとお相手できないかも知れませんので、しばらくお使いになってみて、不具合がありましたらお知らせください。

--------------------------------

　また、今後のご参考までに、勝手なことを申しますが、お返事は結構ですので、適当に読み飛ばしてください。

[１] 今回お示しいただいたような「ＷＥＢページ」の件のように、回答者が知っていると、理解しやすいような材料は、遠慮すべき点はそれなりに踏まえながらも、出し惜しみをされない方が、解決が早くなるかと存じまし、回答者も無駄な回答をせずに済みますし、ご質問者さんも、無駄な説明や解読をせずに済むかと存じます。

[２] ご質問する時点で、ご自分で「これをするにはこの方法だ。これはどうすればよいか」というように、方法論を決め打ちしない方がよいかと存じます（前のご質問も、このご質問もそうですね）。

　≪前後の状況も含めて≫「これこれこういうことがしたい。どんな方法があるか」というように、少し曖昧にお尋ねになった方が、よりよい（幅広く、効率的な）回答が得られるかと存じます。

[３] このような掲示板では、１つのご質問で追加のご質問をされることは マナー 違反だ、というようなご意見もあります。

　時と場合によろうかとも存じますが、１つのご質問で、何か方向性が見つかったときには、一旦、そこで回答を打ち切り、続いて、別のご質問投稿をする、というような方が、スレッド 自体も読みやすいかも知れません。

　回答者によっては、そういうブツ切りのご質問を嫌がられる方もいらっしゃるようですが、第３者が読んで分かりやすい スレッド の方が サイト 側にも メリット がありましょうし、ご質問者も回答者も理解が簡単になる場合もあります。

[４] ちなみに、今回のご質問にしても、ＷＥＢページ から、そのまま データ を読み込んで、ワークシート に「計算式」をちりばめることなく、ＶＢＡ だけでお望みのことが達成できます。

　しかし、回答者も、ご質問者さんの スキル に合わせて回答するはずですが、多少の スキルアップ を目指す向上心のある方でしたら、少々 ハードル の高い回答も得られるかと存じます。

　現に、私も、noro6857 さんの旺盛な向上心が伝わってきましたので、こんなに長くお付き合いする羽目になってしまいました。
　　　(≧ε≦)ノ彡

[５] 回答の中で何度も申しましたが、今回の件は、≪そもそも≫「ワークシート の構成」・「計算式の式立て」に大いに問題があろうかと存じます。

　先ず、お楽なときに、その辺りを見直されることをお薦めいたします。

　お仕事かご趣味かは存じませんが、ご健闘をお祈り申します。

回答No.28

DOUGLAS_

Do Until endRow = FirstLine
　　　TitleLines = TitleLines & " " & endRow
　　　endRow = Columns(1).FindNext(after:=Range("A" & endRow)).Row
　　Loop

　　TitleLines = Split(TitleLines)

'■■■【３】グループ ごとの繰り返し作業開始
　For g = 0 To UBound(TitleLines)
　　'開始行・終了行の設定
　　　startRow = TitleLines(g)
　　　Range("A" & startRow).Select
　　　If g = UBound(TitleLines) Then
　　　　endRow = Range("A" & Rows.Count).End(xlUp).Row
　　　Else
　　　　endRow = TitleLines(g + 1) - 1
　　　End If

　　　strFileName = Range(Left(strCols, 1) & startRow).Value

　　'グループの内容確認用のデータを作成
　　　DataChecker = Range(Range("A" & startRow), Range("A" & endRow))
　　　DataChecker = Application.WorksheetFunction.Transpose(DataChecker)
　　　If IsArray(DataChecker) Then _
　　　　DataChecker = Join(DataChecker, vbCrLf)

　　'ファイル名の入力
　　　If Replace(Replace(DataChecker, vbCrLf, ""), "#VALUE!", "") <> "" Then
　　　　DataChecker = StrConv(startRow, vbWide) & "行目：「" & _
　　　　　Left(strFileName, 10) & "」" & "に続く文字列を入力してください。" _
　　　　　& vbCrLf & vbCrLf & "====================================================" & _
　　　　　vbCrLf & vbCrLf & DataChecker
　　　　strAddName = InputBox(DataChecker, "ファイル名の入力", Mid(strFileName, 11, 100))
　　　　If strAddName = "" Then
　　　　　MsgBox "ファイル名が入力されませんでしたので、終了します。"
　　　　　GoTo Closing
　　　　Else
　　　　　strFileName = Left(strFileName, 10) & strAddName
　　　　　'開始位置にファイル名を格納
　　　　　　Range(Left(strCols, 1) & startRow).Value = strFileName
　　　　End If
　　　End If

　　'ファイルのフルパスを設定
　　　strFullPath = strSaveFol & strFileName & ".txt"

　　'ファイルを作成
　　　Set objTS = objFSO.CreateTextFile(filename:=strFullPath, Overwrite:=True)

　　'データの書き込み
　　　For i = 1 To Len(strCols)
　　　　For j = startRow To endRow
　　　　　If Cells(j, Mid("RQPOMN", i, 1)).Text <> "" Then _
　　　　　objTS.WriteLine Cells(j, Mid("RQPOMN", i, 1)).Text
　　　　Next j
　　　Next i
　　　objTS.Close

　　Next g

　'連続作業終了
　　Range("A1").Select

'■■■【４】後片付け
Closing:
　Set objTS = Nothing
　Set objFSO = Nothing
End Sub

お礼

一つ処理の追加の是非について。
ファィル書き込みの際「同一名ファィルの存在による上書き可か別か」の警告か
あるいは「同一名ファィルがあるときは重複防止の付帯番号をつけて処理」が
あると便利かもしれません。（うっかり重複処理防止のため）

回答No.27

DOUGLAS_

Sub Group_for_each_Title_Line()
　'変数の宣言
　　Dim objFSO As Object　　　　'FileSystemObject オブジェクト
　　Dim objTS As Object　　　　 'TexobjTStream オブジェクト
　　Dim g As Long　　　　　　　 'グループカウンタ
　　Dim DataChecker As Variant　'グループの内容確認用のデータ
　　Dim strFullPath As String　 'ファイル の フルパス
　　Dim strSaveFol As String　　'保存先フォルダ名
　　Dim strFileName As String　 'ファイル名
　　Dim strAddName As String　　'追記文字

　　Dim strCols As String　　　 '列番号の順列
　　Dim TitleLines As Variant　 'タイトル行番号の配列
　　Dim FirstLine As Long　　　 '第１開始行
　　Dim startRow As Long　　　　'開始行
　　Dim endRow As Long　　　　　'終了行（一時流用）
　　Dim i As Integer　　　　　　'列カウンタ
　　Dim j As Long　　　　　　　 '行カウンタ

　'Ａ列最終行より後のセルがアクティブのときは即終了
　　If ActiveCell.Row > Range("A" & Rows.Count).End(xlUp).Row Then
　　　MsgBox "データがありませんので、終了します。"
　　　Range("A1").Select
　　　Exit Sub
　　End If

'■■■【１】下準備
　'オブジェクト の準備
　　Set objFSO = CreateObject("Scripting.FileSystemObject")

　'データ読み込み列の順列の設定
　'▼書き出し列の増減・順序の変更はここで▼
　　strCols = "RQPOMN"

　'ファイル保存先フォルダの指定
　　strSaveFol = "D:\hoge\"

'■■■【２】タイトル行の割り出し
　'第１開始行
　　FirstLine = Range("A1").End(xlDown).Row

　'アクティブ行が FirstLine 未満の場合は検索開始行を FirstLine に
　　If ActiveCell.Row < FirstLine Then Range("A" & FirstLine).Select

　'アクティブ行のＡ列が空白セルの場合は検索開始行を直下のタイトル行に
　　If Range("A" & ActiveCell.Row).Value = "" Then _
　　　Range("A" & ActiveCell.Row).End(xlDown).Select

　'アクティブ行がタイトル行の場合は、TitleLines に含め
　'その他の場合は、上方向にタイトル行を探す
　　If Range("A" & ActiveCell.Row).Find("：*／") Is Nothing Then
　　　TitleLines = Columns(1).Find(What:="：*／", after:=Range("A" & ActiveCell.Row), _
　　　　LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
　　　　xlPrevious, MatchCase:=False, SearchFormat:=False).Row
　　Else
　　　TitleLines = ActiveCell.Row
　　End If

　'以下、アクティブ行からＡ列最終行まで、タイトル行を探す
　　endRow = Columns(1).Find(What:="：*／", after:=Range("A" & ActiveCell.Row), _
　　　LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
　　　xlNext, MatchCase:=False, SearchFormat:=False).Row

お礼

25によりWEB張り付けたもので27～28のマクロを実行しました。
今回はすべてうまくゆきました。
(保存フォルダは実際のフォルダに書き換え）
最初の頃の追記タイプに比べるとまったく楽な作業です。
ただし、最初の頃の手法も知識を得たということで、
今後、類似作業にも役立たせることができそうです。
ほんとうにありがとうございました。

なお「ご参考までに」のあたたかいご忠告は十分こころして今後に役立てたいと思います。
前回のときだったのですが、あわせてファィルの呼び出し方もお尋ねしたところ
それは別の質問でということで途切れてしまった経緯があるため今回のような形になりました。
どうしても回答をいただいていくうちにあれもこれもと、発展してしまい、
本来の質問から大きく飛躍してしまいがちです。
勉強心を持っているからこそ、ということでお許しください。

また
>ワークシート に「計算式」をちりばめることなく、ＶＢＡ だけで
のようなことも、自分の知識がないためほかのアイデアが考えつかず、
単純に現作業からの延長を中心にお尋ねしてしまい、ご迷惑をかけたかと思います。

それにもかかわらず、たくさんの時間をさいていただき非常にご丁寧にご指導していただき感謝しています。

実はエクセルのマクロは、今回（前回の方から）初めて手がけたものです。
なので、今回のNo1の頃はまだ新規のマクロファィルの作り方も知らずに、
その都度、自動記録によりワンキーのみで作成して、そこに教えていただいたマクロを張り直していました。（いっそのことお聞きしようと思っていたくらいです）
途中からVBEDITORの標準モジュールから作成すればいいことを知ったというまったく素人なのです。

ふだんなかなかエクセルそのものを使う作業の必要性がないため、おろそかになりがちですが、
もっとマクロを勉強するとなかなかおもしろい作業もできることを痛感しました。

回答No.26

DOUGLAS_

段々と、話がややこしくなって、『【Ａ】追記案』では限界を感じましたので、いきなり、『【Ｂ】Excel VBA だけ』で コード を書かせていただきました。

--------------------------------

１）先ず、No25 の ２つ の １行マクロ を実行しておいていただけると、Ｍ列～Ｒ列 の中には エラー値 が、基本的にはなくなるかと存じますので、No23 の「Using_Web_query()」の改訂版（下記）に ２行マクロ も セットしました。

２）タイトル行 の行番号を配列に格納し、配列の要素を グループ の単位区切りとして判断するようにしております。
　Ａ列に「：～／」という文字列が含まれない行は タイトル行 には、なり得ない、という判断でよろしかったですよね。

３）アクティブ行 を含む グループ より下方向の グループ を対象に マクロ が実行されます。

４）A1セル あたりを アクティブにして、２つ目の マクロを実行すると、ファイル名 入力の ダイアログ が表示されますが、すべて [OK] で対応してください。

５）(４) による ワークシート内 の変化は、タイトル行Ｒ列 の値が、計算式から文字列に変わるだけです。

６）マクロ 終了後、「D:\hoge\」フォルダ の中をご確認ください。

--------------------------------

Sub Using_Web_query()
　Dim arrMenu As Variant
　Dim myDate As String
　Dim myURL As String
　Dim Connection_URL As String

　arrMenu = Array(70, 80, 32, 62, 101, 102, 90, 120, 40, 22, 31)
　myDate = InputBox("オープンする日付を「月／日」のように入力してください。", _
　　"日付の入力", Format(Date, "m/d"))
　myURL = InputBox("オープンするジャンルを番号で入力してください。" & vbCrLf & vbCrLf & _
　　StrConv("1.THE CLASSIC" & vbCrLf & "2.THE JAZZ" & vbCrLf & "3.SWING EASY" & vbCrLf & _
　　"4.歌謡＆演歌" & vbCrLf & "5.ROCK" & vbCrLf & "6.CROSS CULTURE" & vbCrLf & _
　　"7.GROOVE" & vbCrLf & "8.KLASSE" & vbCrLf & "9.EASY LISTENING" & vbCrLf & _
　　"10.j -HIobjTS" & vbCrLf & "11.COMMUNITY", vbWide), "メニューの選択", 1)
　myURL = Format(arrMenu(myURL * 1 - 1), "0000")
　myURL = myURL & "/" & myURL & Format(Split(myDate, "/")(0) * 1, "00") & _
　　Format(Split(myDate, "/")(1) * 1, "00")
　　　　　　　　　　　'↓　ここにサイトのＵＲＬを書く。
　Connection_URL = "http://www.musicbird.jp/program/" & myURL & ".html"
　Columns(1).ClearContenobjTS
　With ActiveSheet.QueryTables.Add(Connection:= _
　　"URL;" & Connection_URL, Destination:=Range("A1"))
　　.WebFormatting = xlWebFormattingNone
　　.WebTables = "9"
　　.Refresh BackgroundQuery:=False
　End With

　'Ａ列が「空白」の行の全体を クリア
　　Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.ClearContenobjTS

　'Ａ列が「数値」の行の Ｌ列 を クリア
　　Columns("A:A").SpecialCells(xlCellTypeConstanobjTS, 1).Offset(, 11).ClearContenobjTS

　'上記の２行で、Ｍ列～Ｒ列内には エラー はなくなりますよね。
End Sub

お礼

26はWEBからの貼り付け、27～28は集計作業と書き出しでよろしいですね。
まず26のみテストしてみました。

>１）先ず、No25 の ２つ の １行マクロ を実行しておいていただけると、
とありますが、26のマクロを実行すればその中に含まれているみたいなので、
26を使用したら25のふたつのマクロの実行は不要と考えていいですか？

>２）Ａ列に「：～／」という文字列が含まれない行は タイトル行 には、なり得ない
これはch9-2に限っています。他のチャンネルは若干ソースフォームが異なるため
別のbooksheetと関数を使用していますのでこの条件はあてはまりません。
したがって、今回の作業のジャンルは「4.歌謡＆演歌」に限っていますので
選択メニューは省略してよろしいかと思います。

それで、一応日付とジャンル選択（入力数字は半角でいいのですね）をしたところで
次のメニューが出てしまいました。
やはりバージョンが古いのでしょうか

438
このプロジェクトのプロパティ&メゾットはサポート外

なお、L列のタイトル欄に数字が出ないよう関数を次のように直しました。(L5)
A列が空白または数字または「：」の存在するときは0表示（非表示）、
でなければ前行または前々行が0のときは直前の数字に1を加えて連続にする。
該当外は1（直前0+1)から表示としました。結果的にマクロで空白行になる場合もありますが
タイトル欄からは数字は排除されます。

=IF(ISNUMBER(A5),0,IF(A5="",0,IF(ISERR((FIND("：",A5,1))),IF(L3+L4=0,1+L2,IF(L4=0,L3+1,L4+1)),0)))

ということで、26で止まったため27～28はまだ実行していませんが、25のマクロで再度WEB貼り付けしたものでこのあとやってみます。

回答No.25

DOUGLAS_

今、落ち着いて、過去の「お礼」なり「補足」なりを読み返してみました。

　No23 の「Sub Using_Web_query()」を実行し、No12 の「お礼」に書かれている サイト の １ページ を ワークシート に展開してみました。

　確かに、No12 の「お礼」に書かれている
＞(13)（空欄）
＞(14)（空欄）
のような行が存在し、
＞(8)1:00
のような列の場合には、
＞(M～R)がエラー表示され
ますね。

--------------------------------

　話を掘り返すようですが、
＞※(15)からはグループ２になります。
というのは、Ａ列に
＞(15)０２：００／ＯＬＤＭＩＸ
というような表示がある場合のみ スタート 行になり、その他の場合には、スタート 行にはならない、と考えてよろしいでしょうか？【質問13】

　ただし
＞(8)1:00
のような、半角の「1:00」だけの場合は除く、でよろしいでしょうか？【質問14】

--------------------------------

　１つ分からないことがあるのですが、どうして
＞※(7)は不要行
＞この場合12も不要
なのでしょうか？

＞(7)・ Ａ４○○○ ／ Ｂ４△△ ＜ AA12348 ＞
も
＞(12)・ Ａ８○○○ ／ Ｂ８△△ ＜ AA12385 ＞
も、他の行と同じような内容ですが、これは noro6857 さんの「趣味」の問題で、たまたま削除しただけのお話しでしょうか？【質問15】

　それとも、
＞(8)1:00
で ブロック が２つに区切られているとして、ブロック 前半の最終行と、ブロック 後半の最終行は、常に対象外にする、つまり、削除する、という意味でしょうか？【質問15】

--------------------------------

　【質問13・14】の答えが私の考えている通りだとすると、グループ の区切りは、Ａ列の値から求めることができそうです。

　「ただし、例外があります」というようなお話しでしたら、振り出しに戻ります。

　【質問15】の答えが、noro6857 さんの「趣味」の問題ではなくて、後者の意味だとしたら、計算式を改善して、余分な削除の手作業を減らすことができるかも知れません。

--------------------------------

　なお、No23 の「Sub Using_Web_query()」を実行した後のように、ＷＥＢページ から データ を貼り付けたばかりの段階で、

Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.ClearContents

という コード を実行すると、「Ａ列が空白」の行全体の計算式をいっぺんに削除する（空白にする）ことができます。
　「Ｍ列～Ｒ列」の計算式だけを削除することもできます。

　また、
Columns("A:A").SpecialCells(xlCellTypeConstants, 1).Offset(, 11).ClearContents

という コード を実行すると、「Ａ列が数値だけ」（例えば「1:00」）の行の Ｌ列の 計算式をいっぺんに削除する（空白にする）ことができます。

--------------------------------

　このように、変わらない規則がある場合には、煩雑な作業を、たった １行 の マクロ でやっつけてしまうこともできるのですが、【質問15】のように noro6857 さんの「趣味」の範囲で、「削除したりしなかったり」というような作業形態の場合には、マクロ による統一作業は相応しくありません。

お礼

【質問13】
セルの関数式にもあるように全角２：００の様な場合「：」があると、タイトル扱い（グループの先頭行）になります。例外はありません。
【質問14】
2:00のような半角はグループ内の途中区切りなのでエラーとなるためこれは空欄とし、前後は同一グループになります。
グループごとの区切りは空欄が何行（不定）か存在します。
【質問15】
これはソースを説明することになりますが、各データは１時間内に納まる曲が放送され、
時間内の最終曲は１曲納まらない場合、フェイドアウト、または演奏のみとなっています。
この演奏のみの場合は、アーチストの欄で判別できます。
これは時間調整的な内容ですので不要というわけです。
したがって最終曲が演奏者だったら削除、アーチストだったら取り込みます。
そのため、これを分けるには個人の判断が必要になってしまうのです。

なお書きの部分はＡデータからの判定で関数式でも可能かもしれません。（さすがに関数では式削除は不可ですが）
当然、マクロもありかもしれませんね。
今のところまだその余裕がないのですが検討の余地ありです。

補足

今
Sub Using_Web_query()
のマクロと
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.ClearContents
と
Columns("A:A").SpecialCells(xlCellTypeConstants, 1).Offset(, 11).ClearContents
を入れてやってみました。おお！すごいですね。
見事、空白行、式削除行ができあがっている！
いやぁ、エクセルってとんでもないことができるんですねぇ！
タイトルの■の前に数値の1が入ってしまうのでこれは関数で対処可能です
あとの手動削除だけはムリとしても、これは使う気になります。
思いがけない知識を得ました。

この場合、htmlのアドレス（たぶん日付が入る部分が変化）はその都度変わる訳ですが
日にち指定もできるとあったので、たぶんアドレス記入コードに指示を与えるようになるのでしょうが
これができたらサイトを開く必要もなさそうですね。

※補足欄は本来回答者が使用する欄らしいですが、回答の場所がなくていつも使ってしまいごめんなさい。

回答No.24

DOUGLAS_

ん～～～～。。。　　(´ヘ｀;)
ん～～～～。。。　　(´ヘ｀;)
ん～～～～。。。　　(´ヘ｀;)

　どうも申し訳ございません。

　やっぱり不具合がありますね。

＞『スタート位置のＲ列の値は「■MB」で始まる』ように
することは撤回いたします。

　操作をした後に、再度、マクロ を走らすと、結局 スタート位置が分からなくなってしまいますね。

　やはり、少々の不具合には目をつむっていただいて、Ｒ列 において [Ctrl] + [↓] で選択するのが ベスト かと存じます。

お礼

■を撤回ということは
20～21に戻すということでしょうか。
あるいはMBで対応する22修正版でしょうか
いずれにしても第１グループが排除されてしまうパターンになりますが。
更に例のデバックで、選択範囲が点線で囲まれた状態でメッセージが
出てしまうため、15から修正した17までさかのぼってとりあえずそれを利用しています。
（１度はスムースにできた感じがしたのですが、以降うまくゆきません。
なおエクセルは2003、VBAは6.0なのでちょっと古いかもしれません。）
また、Ｒ列 において [Ctrl] + [↓] というのはどの段階で使えるのかわからず
OKメッセージが出ていると使えないし、ＯＫを押してしまうと、
空セルへジャンプして集計が始まってしまう（＝空セルでタイトル欄追記指示）
になってしまって使う機会がよくわかりません。

No15を基本にして16～17で直したものを運用
これに　Range("A1").Selectを加える
※EMEDITORで１行目をなおすパタン
16空セル対応した
17途中中断を加えた

No20～21（追記メニュー採用版)を基本に22に直す
＞２グループ以降に移るとき、
＞A1へジャンプして終了
MBを検索に修正

23に直す
１行目が集計できないを■で修正

回答No.23

DOUGLAS_

先ず、前回答につきまして、不具合がありましたので、

＞１グループでマクロを実行すると、
＞２グループめのタイトル追記メニューと内容になります。

も含めて訂正いたします。

　勝手ながら『スタート位置のＲ列の値は「■MB」で始まる』ようにしていただければと存じますので、

・R3 以下の セル に入る計算式を
=IF(K3="A","MB"&F3&"="&A3,IF(K3="","",FIXED(L3,0,TRUE)&"."&Q3))
から
=IF(K3="A","■MB"&F3&"="&A3,IF(K3="","",FIXED(L3,0,TRUE)&"."&Q3))
に変えてください。

・コード の中の「What:="MB"」を「What:="■MB"」に変えてください（２ヶ所）。

・コード の中の「Left(Selection.Value, 10)」を「Mid(Selection.Value, 2, 10)」に変えてください（２ヶ所）。

・「actRow = ActiveCell.Row」の下に
　If Left(ActiveCell.Value, 3) <> "■MB" Then _
を追加してください。

　以上で、いかがでしょうか？

--------------------------------

＞Openclipboardに失敗しました。
　誠に恐縮ですが、そちらの Excel の バージョン や パソコン 自体の スペック にも関わりがあるかも知れませんし、そちらの ワークシート の構成が分かりませんので、原因が分かりません。

--------------------------------

＞本来消すべき順列数字をうっかり消し忘れ・・・
　人間の手によって、不規則な操作が加えられた データ を、マクロ で一律に扱うことは不可能です。

　「必ずこうである」という法則を作らなければなりませんので、『スタート位置のＲ列の値は「■MB」で始まる』みたいなことにしてみました。

　本当は、予め計算式の入力された セル 範囲の データ を、手作業で直したり削ったり、というような操作のあり方自体が、私的には問題があると思っております。

　そういうことをしなくて済むような シート 構成にしてから ＶＢＡ を組むべきかと存じますね。
　特に、計算式には、非常に多くの無駄な操作が見受けられます。

--------------------------------

＞収集列範囲を増やしたい場合
　こういうことをお尋ねになるということは、列の順番が変わる可能性はありませんか？

　例えば、そのようなことが起こりうるようでしたら、「データ抽出（空白セルは抽出しない）」の下の コード も変えなければなりません。

　先ずは、コード １行１行の意味をよくご理解ください。

================================

＞なおデータソースはリンク・・・
　この件をもっと早い段階でお示しいただいていれば、解決も早かったかと存じます。

--------------------------------

　ちなみに、「ＷＥＢページ から データ を引っ張ってくる」ということも Excel VBA では可能です。

　何も入力されていない 新規ブック を アクティブ にしてお試しください。
　「***.jp」の部分は、必ず「データソース」のサイトのＵＲＬを書いてください。

--------------------------------

Sub Using_Web_query()
　Dim Connection_URL As String
　　　　　　　　　　　'↓　ここにサイトのＵＲＬを書く。
　Connection_URL = "http://www.***.jp/program/****/********.html"
　Columns(1).ClearContents
　With ActiveSheet.QueryTables.Add(Connection:= _
　　"URL;" & Connection_URL, Destination:=Range("A1"))
　　.WebFormatting = xlWebFormattingNone
　　.WebTables = "9"
　　.Refresh BackgroundQuery:=False
　End With
End Sub

--------------------------------

　コード をあと １０数行 加えれば、お好きな年月日のお好きなジャンル の ページ を ダウンロード することもできます。

お礼

ありがとうございました。
今回は「Openclipboardに失敗しました。」のエラーも出ずうまくゆきました。
ひとつだけ集計できないグループ（１行目の■だけ収集）があって、最終グループなのですが、
できるシートとできないシート（できないシートはほかの日の類似最終グループも共通してできない）
があるため、その違いの説明がつかないので、算式やフォームでどこか違いがあるのか研究してから
機会が残っていればご説明します。

＞なおデータソースはリンク
私も実物を提示してお願いするのが一番てっとり早いとは思っているのですが、
参照リンクや元データ等を記述すると、なぜか「違反書き込み」とされることがあり、
現実にQ&Aが削除されたことがありました。
せっかく貴重なやりとりが消されてしまうのももったいないので慎重になっているところです。
「ＷＥＢページ から データ を引っ張ってくる」は面白そうなのであとで試してみます。

関数については、ご指摘のとおり「多くの無駄あり」で自分でも自覚しています。
前にも書いたとおり、最初から計画的に作ったものでなく、あとから追記を繰り返してしまったため、かなりダブリの部分も存在していますが、整理しなおせば直すところはたくさんあるのですが
面倒なので放置している次第です。失笑されるのもご無理ないと思います。

回答No.22

DOUGLAS_

＞２グループ以降に移るとき、
＞A1へジャンプして終了
　以上２点につきまして、下記のトコロを書き換えてください。

--------------------------------
'//変数の宣言
のトコロに、
　Dim actRow As Long　　　　'初期アクティブ行
　Dim nextRow As Long　　　 '次期アクティブ行
を追加。
----------------
　MsgBox "スタート行をアクティブ にしてください。"
　Range("R" & Selection.Row).Select
の行を削除。
----------------
'//グループ ごとの繰り返し作業開始
　Do
の後に、
'//次の「スタート位置」を選択
　Range("R" & Selection.Row).Select
　actRow = ActiveCell.Row
　Range("R:R").Find(What:="MB", After:=ActiveCell, LookIn:=xlValues, LookAt _
　　:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
　　False, MatchByte:=False, SearchFormat:=False).Select
　If ActiveCell.Row < actRow Then Range("A1").Select: Exit Sub
　nextRow = Range("R:R").Find(What:="MB", After:=ActiveCell, LookIn:=xlValues, LookAt _
　　:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
　　False, MatchByte:=False, SearchFormat:=False).Row
を追加。
----------------
　　Set rng = Range("M" & ActiveCell.Row, "R" & ActiveCell.End(xlDown).Row)
を
　　Set rng = Range("M" & ActiveCell.Row, "R" & nextRow - 1)
に置き換える。
----------------
'//次の「スタート位置」を選択
　　Selection.End(xlDown).End(xlDown).Select
を削除。
----------------
End Sub
の前に、
　Range("A1").Select
を追加。
--------------------------------

　以上で、

１）アクティブ行から下方向に向かって、Ｒ列内で最初に「MB」の現れる セル が スタート 位置になります。
　以下、わざわざ「Ｍ列～Ｒ列」の データ を削除しなくても、次の「MB」が入力された Ｒ列 の セル が、次の スタート 位置になります。
　つまり、Ｋ列 に「A」と入力するだけで、その行が開始行になります。

２）マクロ終了後は A1 セル が アクティブ になります。
　ただし、「ファイル名の入力」ダイアログ を キャンセル したときと、「EmEditor での作業が終わったら OK」の メッセージ を キャンセル したときには、スタート 位置 で終了します。

================================

＞当事者同士のみのローカル的なやりとりで
あるが故に、私的には、結構、好きな回答を書けているようにも思えます。

　他者が参入してくると、却って noro6857 さんご自身も、複数の回答者相手に考えなければならなくなり、頭の数がそれだけ必要になるように存じますが、いかがでしょうか？

＞サイトに気が引ける
　私は、「この質疑応答を他の方がご覧になって、何かの ヒント になれば」と思って、そういう スタンス で、常々、回答しているつもりです。
　なればこそ、
＞このQ&Aは他の方にも公開され使える方にも役立てる
のであって、むしろ、中途半端な終わり方をするよりは、「答えが出た」というトコロで終わるべきかと存じますが、いかがでしょうか？

--------------------------------

＞次の質問を別トビにしたい
　「次の質問」が何を指すのかは存じませんが、コード は、ほぼ出来上がっておりますので、今しばらくお待ちください。

　次の回答が最後になりますように。　(^∧^)

お礼

>本当のトコロはどうなんでしょうか？
どこかのぶれる首相みたいですね。すみません。
>１０種類くらい／特定文字の種類が20通り
正確に数えていないのでアバウトで書いたのですが、種類としては10種類くらい
特定文字で区分すると20通りという意味なのですが、これも違っているかもしれません。

＞連続しなくてすむ方法もあったほうがよさそうな気がします。
＞（時々データ1に付する「1」を間違えて、
＞タイトルから付してしまうことがあるからです）

これは、順列数字(L列）をR列のように付するとき、
タイトルつまり■の欄の本来消すべき順列数字をうっかり消し忘れ、残っていると
そこが1となって、肝心のデータ１行目が2から始まってしまうということです。
しばしばあとから気がつく時があります。

(R)2.Ａ１○○○(Ｂ１△△)
ただし、今回「キャンセル」を入れていただいたので、この問題は解決しました。

>プルダウン方式マクロで対応することは可能です
これは自分で対応可という意味でなく、プルダウンメニューの中にワード候補を
いれるように整理できるという意味ですが、
作成方法がQ&Aのやりとりにそぐわないということであるので撤回します

あと、応用でお聞きしておきたいのですが、収集列範囲を増やしたい場合
コード中の
　Set rng = Range("M" & ActiveCell.Row, "R" & ActiveCell.End
の部分をM～Sのようにすればいいのでしょうか。他にも関連記述がありますか？

ということでここまでをほかのところに書きかけていたらこのご回答が入りましたので、回答場所が
不揃いになりますがあわせてご返事させていただきます。

>他者が参入してくると
多分このやりとりをみてすると他者が参入してくる余地はないと思いますが
途中でほかの案が浮上してきたりするとお説のとおり混乱します。
が、そのために他者の書き込みを封じてはいけないのかなと自戒しています。
通しで対応していただいているのでとても助かっているのですが。

次の質問というのは追記案が１件落着となったところで、
次のVBA取り込み案を別のトビに分けようかなと考えたのです。
もしかしたらVBAで更に20回くらいやりとりをすることになるのかなと思ったのですが
関連で分割するとわかりにくくなるのではあればこのまま続けさせていただきます。

勝手なことを述べて申し訳ありません。

補足

修正した内容について動作結果をご報告します。
※
１グループでマクロを実行すると、２グループめのタイトル追記メニューと内容になります。
たぶん最初のグループの１行めからスタートさせると、
次のMB（すなわち２グループ）を拾ってしまうのではないかと感じます。

２グループめが終わって次のOKを押すと次のようなメッセージが出ました

実行時エラー2147221040(800401d0)
DateObjectGetText Openclipboardに失敗しました。

デバックを見ると次の部分がハイライトされていました。
//ファイル名 の入力
strData = .GetText

今回の修正、追記のしかたが間違ったのかもしれませんが、確認はしたつもりです。

回答No.21

DOUGLAS_

'//EmEditor を起動
　　If Replace(Replace(buf, vbCrLf, ""), "#VALUE!", "") <> "" Then
　　　wshShell.Run """D:\Program Files\EmEditor\EmEditor.exe"" /i", 1, False
　　　If MsgBox("「" & Selection.Text & "」から始まる グループ について" & vbCrLf & _
　　　　vbCrLf & "EmEditor での作業が終わったら OK してください。" & vbCrLf & _
　　　　vbCrLf & "操作を中止する場合は キャンセル してください。", 1) _
　　　　= vbCancel Then Exit Sub
　　End If

'//書込用バッファ を解放
　　buf = ""

'//次の「スタート位置」を選択
　　Selection.End(xlDown).End(xlDown).Select

'//ワークシート最終行まできたら、
'//グループ ごとの繰り返し作業終了
　Loop Until Selection.Row = Rows.Count
　Set rng = Nothing
End Sub

--------------------------------

＞途中でEditorの作業が手動で発生するのが煩わしい

　ここまで来たら、結局
＞【Ｂ】この際、EmEditor を用いずに Excel VBA だけで済ます。
という段階に入っていますよね。

--------------------------------

　ということで、問題がなければ、
＞【Ａ】やはり、最初の追記案に絞って質問をスタート。
はこの辺で終わりにして、次の段階に入りたいと存じます。

--------------------------------

　ここで、私の判断ですが、
＞【Ｂ】この際、EmEditor を用いずに Excel VBA だけで済ます。
という段階に来て、人様が書かれた コード を弄くり回して逃げるのはいかがかと存じますし、上記 コード では、「ファイルの保存」まではできませんので、再び振り出しに戻って、No4 - No6 の コード を弄るのが適正かとかと存じます。

--------------------------------

　取り敢えず、
＞【Ａ】やはり、最初の追記案に絞って質問をスタート。
の段階で、何か疑問の点などがありましたら、今の内にお尋ねください。

　noro6857 さんの ＧＯサイン が出てから
＞【Ｂ】この際、EmEditor を用いずに Excel VBA だけで済ます。
に入りたいと存じます。

お礼

noro6857 さんの ＧＯサイン が出てから
＞【Ｂ】この際、EmEditor を用いずに Excel VBA だけで済ます。
に入りたいと存じます。

了解しました。とりあえず追記スタイルまではできていますのでこれでいいかと思います。
ひとつだけお願いしたいことは、データループ終了の際カーソルが65526行で止まります。
これをctrl+homeで機能するA1へジャンプして終了するマクロを追記していただけますか。

それとこのQ&Aは他の方にも公開され使える方にも役立てるようになっているので
当事者同士のみのローカル的なやりとりであまりスペースをとると趣旨に反してしまうかも
しれません。（サイトに気が引けるので）
それで次の質問を別トビにしたいと思いますがいかがでしょうか。
ここも残しておきますが、トビを立てたら番号をここに書いておきます。

なおデータソースはリンクを記述できませんので、キーワードでMusicBird 9ch-2 ソングリスト
です。

補足

No20,21で早速試してみました。R列１行目に追記コマンドを入れてくださったのですね。
基本的にはこれでいけるかと思います。

ただ、ひとつだけ問題が。
２グループ以降に移るとき、算式削除行の次のR列からスタートするようになっているのですが
グループ間は、算式削除行のあと次のスタートまでに空白行（算式有り行）が存在し、
その行数は不定です。
No12のお礼欄(13)(14)（空欄）に相当するものです。

したがって空白行からスタートすると追記コマンドが空白行に対して処理されることになります。
そこで、次のスタート行は算式削除行の次からであってもセルが空白であったら
それを飛ばすことにするか、スタート位置をマウスで変更できるようにならないと
せっかくの追記機能がうまく機能してくれません