ChromeのブックマークをHTMLにエクスポートし、それをExcelへコピペし、本物のブックマークのような項目別に折りたたみができるようなHTMLにいつでも改良してくれるマクロを作っています。以下の処理をVBAで表していただけませんでしょうか?
①先ず「<DT><A HREF=」を検索して、
②その行(※0)から1つ上の行(※1)が「<DL><p>」であり、
③その更に1つ上の行(※2)に「§」の文字が無い場合、
④その行(※2)の文字列の先頭に「<div onclick="obj=document.getElementById('折畳中').style; obj.display=(obj.display=='none')?'block':'none';"><a style="cursor:pointer;">」を追記し、
⑤語尾に「</a></div><div id="折畳中" style="display:none;clear:both;">」を追加する。
⑥更に最初に検索した行(※0)から下方向に1段ずつ「</DL><p>」を検索していき、
⑦該当文字列が見つかった場合、その列の文字列を「</div></DL><p>」にする(置換でも追記でもどっちでもいい)。
⑧この一連の処理をA列又は全てのセル(どちらでもいい)で連続処理する。
⑨次に「▼」を検索して、
⑩その行の文字列の先頭に「<div onclick="obj=document.getElementById('折畳大').style; obj.display=(obj.display=='none')?'block':'none';"><a style="cursor:pointer;">」を追記し、
⑪語尾に「</a></div><div id="折畳大" style="display:none;clear:both;">」を追加する。
⑫更にその行から下方向に1段ずつ「▼」を検索していき、見つかったら
⑬見つかった列の1つ上の文字列が必ず</DL><p>なので「</div></DL><p>」にする(置換でも追記でもどっちでもいい)。
⑭次に「§1」を最上部より検索して、
⑮該当列から2つ上の列内の文字列の先頭に「<div onclick="obj=document.getElementById('折畳小').style; obj.display=(obj.display=='none')?'block':'none';"><a style="cursor:pointer;">」を追記し
⑯語尾に「</a></div><div id="折畳小" style="display:none;clear:both;">」を追加する。
⑰「§1」を最下部より検索して、
⑱見つかった列から1つ上の文字列が必ず</DL><p>なので「</div></DL><p>」にする(置換でも追記でもどっちでもいい)。
⑲最後にA列又は全てのセル(どちらでもいい)の内、「'折畳中'」という文字列をTOP(最上部)から順に「'折畳中1'」「'折畳中2'」「'折畳中3'」・・・と連番付けしていく(置換でも追記でもどっちでもいい)。
⑳また「"折畳中"」という文字列も同じようにTOPから順に連番付けしていく。
21,最後にA列又は全てのセル(どちらでもいい)の内、「'折畳大'」という文字列をTOPから順に「'折畳大1'」「'折畳大2'」「'折22,また「"折畳大"」という文字列も同じようにTOPから順に連番付けしていく。
23,最後にA列又は全てのセル(どちらでもいい)の内、「'折畳小'」という文字列をTOPから順に「'折畳小1'」「'折畳小2'」「'折畳小3'」・・・と連番付けしていく(置換でも追記でもどっちでもいい)。
24,また「"折畳小"」という文字列も同じようにTOPから順に連番付けしていく。
何卒よろしくお願いします。
No.3ベストアンサー
- 回答日時:
ママチャリです。
申し訳ありません。私が書いたサンプルに漏れがあったようです。
FindNextを書き忘れたため、最初に見つかったもののみの処理となっていました。
修正してみたので、こちらでお試しください。
Sub sample①から⑧まで()
Dim c As Range
Dim firstAddress As String
Dim r As Range
With Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set c = .Find("<DT><A HREF=", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Offset(-1).Value Like "<DL><p>" And _
Not c.Offset(-2).Value Like "*§*" Then
c.Offset(-2).Value = "<div onclick=""obj=document.getElementById('折畳中')" _
& ".style; obj.display=(obj.display=='none')?'block':'none';"">" _
& "<a style=""cursor:pointer;"">" _
& c.Offset(-2).Value _
& "</a></div><div id=""折畳中"" style=""display:none;clear:both;"">"
For Each r In Range(c, Cells(Rows.Count, "A").End(xlUp))
r.Value = Replace(r.Value, "</DL><p>", "</div></DL><p>")
Next
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub
No.1
- 回答日時:
強烈なご質問ですね?とりあえず、仕様通りに①~⑧までのコードを書いてみました。
⑨以降も同じような内容なので、あとはご自分でお願いします。Sub sample①から⑧まで()
Dim c As Range
Dim firstAddress As String
With Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set c = .Find("<DT><A HREF=", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Offset(-1).Value Like "「<DL><p>」" And _
Not c.Offset(-2).Value Like "*§*" Then
c.Offset(-2).Value = "<div onclick=""obj=document.getElementById('折畳中')" _
& ".style; obj.display=(obj.display=='none')?'block':'none';"">" _
& "<a style=""cursor:pointer;"">" _
& c.Offset(-2).Value _
& "</a></div><div id=""折畳中"" style=""display:none;clear:both;"">"
Range(c, Cells(Rows.Count, "A").End(xlUp)).Replace What:="</DL><p>", _
Replacement:="</div></DL><p>", LookAt:=xlPart, MatchCase:=True
End If
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub
自分なりに作り直してみた。しかし、追記(又は置換)してほしい文字列は数多くに上りますが、どうしても最上文しか追記処理をしてくれません。御指南頂けると幸いです。
Dim c As Range
Dim firstAddress As String
With Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Do
Set c = .Find("<DT><A HREF=", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)
firstAddress = c.Address
If Not c Is Nothing Then
If c.Offset(-1).Value Like " <DL><p>" And _
Not c.Offset(-2).Value Like "*§*" Then
c.Offset(-2).Value = "<div onclick=""obj=document.getElementById('折畳中')" _
& ".style; obj.display=(obj.display=='none')?'block':'none';"">" _
& "<a style=""cursor:pointer;"">" _
& c.Offset(-2).Value _
& "</a></div><div id=""折畳中"" style=""display:none;clear:both;"">"
Range(c, Cells(Rows.Count, "A").End(xlUp)).Replace What:="</DL><p>", _
Replacement:="</div></DL><p>", LookAt:=xlPart, MatchCase:=True
End If
End If
Loop While Not c Is Nothing And c.Address <> firstAddress
End With
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) PHPプログラムをエクセルに張り付けると検索ボックスがでてくる! 3 2022/05/08 07:10
- HTML・CSS CSSが効かずどのように指定すれば良いか分からないのでアドバイスお願い致します 2 2023/06/07 12:25
- HTML・CSS アコーディオンメニューが思うように動作しません。 1 2023/08/20 16:48
- HTML・CSS テキストを画面の真ん中に配置したいです。 2 2022/11/25 16:11
- PHP アップロード画像数でCSSを分けることに成功したのですが、画像の横に文字を並べることが出来ません。 3 2023/07/28 17:16
- HTML・CSS CSS のみのタブ切り替えについて 1 2023/01/11 16:47
- JavaScript jQueryでのドラッグアンドドロップについて 1 2022/07/07 21:04
- JavaScript ソースコードのいじる場所が分かりません。 1 2022/12/23 02:06
- JavaScript clear機能を失わずにファイルアップロード機能を作成したい 3 2023/06/10 16:12
- PHP ここでの ②if($su_d<>"")の比較演算子 を使う理由は 1 2022/03/26 02:33
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルでファイルの最終更新...
-
Excelに詳しい方! B列が「日...
-
F9キーについて。
-
Excelファイルが開けません
-
シフト表をエクセルで作るとき...
-
Excel関数について教えてくださ...
-
Excel 小さくなったスクロール...
-
計算能力
-
excel2013 MonthDays 関数が使...
-
スプレッドシートの関数につい...
-
Excel 2019 [オプション]の[リボンのユ...
-
Excelのピボットグラフの作り方...
-
エクセルで 自動的に◯や数字を...
-
【EXCEL】画像の黄色部分の抽出...
-
特定の文字列を含む、住所を抽...
-
EXCELの散布図で日付が1900年に...
-
【マクロ】2回実行したら、エ...
-
Excelで表を作ったところに文字...
-
マイクロソフトのPADを使ってい...
-
Excel分数の表示について
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
画像を2つ横に並べる方法と、...
-
appendChildでのデフォルト値
-
Struts2のAjax Tagが機能しない
-
【HTML、VBScript】HTAでのイベ...
-
seleniumbasic chrome操作について
-
webBrowserに表示されている文...
-
Excel VBAに翻訳して頂けません...
-
複数の要素を表示してる時だけ...
-
MAX関数を使ってからLEFT JOIN...
-
jspでcssが読み込めない
-
javascriptテキストBOX色を元に...
-
JSPでの画像ファイル表示
-
eclipseでcssを使うためには?
-
createElementで作成した要素を...
-
読み込んだQRコードをフォーム...
-
jqueryのsortableで一部ソート...
-
Slick.jsのオプションrtlについて
-
JavaScriptで変更した属性の元...
-
console.log結果をhtmlで表示し...
-
textareaに画像を表示したい
おすすめ情報