[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『htmlを取得して、特定の要素を置換したい』（名無し）
タイトルの内容を詳しく説明すると、vbaでhtmlを取得して、width='100'と書かれている箇所をwidth='100px'というように数字の後ろにpxを追加したいと考えています。
現在、htmlを取得して別シートに張り付けて、width='で検索して該当のセルに移動するところまではいけたのですが、数字の後ろにpxだけを入れることができない状況です。
流れといたしましては、別シートに張り付けてwidth='100px'の形にしたのちに再度htmlに置換した内容を上書きする形を想定しています。
考慮しないといけない点は、widt='100%'やpxがすでに入っているものに関してはそのままにすることです。
ご存じの方がいましたらご教授願います。
Dim wb As Workbook
Dim ws, outputSheet As Worksheet
Dim filePath, replaceWord As String
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet
Set outputSheet = wb.Sheets(2)
filePath = ws.Range("D4").Value
inputFile (filePath)
replaceWord = "width='"
With outputSheet.Columns("A")
.Replace what:=replaceWord, replacement:=""
End With
MsgBox "終了しました"
End Sub
Function inputFile(filePath)
Dim wb As Workbook
Dim outputSheet As Worksheet
Dim buf As String, n As Long
Set wb = ActiveWorkbook
Set outputSheet = wb.Sheets(2)
Open filePath For Input As #1
Do Until EOF(1)
Line Input #1, buf
n = n + 1
outputSheet.Cells(n, 1) = buf
Loop
Close #1
End Function
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
width='100'をwidth='100px'に置き換えるだけでは、
ダメなのでしょうか？
Replace("width='100'", "width='100'", "width='100px'")
（tkit） 2022/01/04(火) 16:59
どこかに穴があるかもしれませんが、 何となくそれらしい事ができたかもしれませんので投稿します。 細かいことを聞かれても答えるスキルがありませんので、改良等はご自身でお願いします。
Sub Sample()
Debug.Print addpx("<table id='tblHdr' width='980' border='0' cellspacing='0'>")
Debug.Print addpx("<table id='tblHdr' width='980%' border='0' cellspacing='0'>")
Debug.Print addpx("<table id='tblHdr' width='980px' border='0' cellspacing='0'>")
End Sub
Function addpx(inp As String) As String
Dim reg As Object
Dim rm As Object
Dim buf As String
If Not InStr(inp, "width='") > 0 Then Exit Function
Set reg = CreateObject("VBScript.RegExp")
With reg
.Global = True
.ignorecase = True
.Pattern = "width='\d{1,4}."
End With
Set rm = reg.Execute(inp)
If Right(rm(0), 1) = "'" Then
buf = Left(rm(0), Len(rm(0)) - 1) & "px'"
addpx = Replace(inp, rm(0), buf)
Else
addpx = inp
End If
End Function
（寒） 2022/01/04(火) 18:24
既に正規表現を使った回答がありますが、書いてしまったので投稿させていただく。
パターンマッチを行う正規表現というのを使うと良いと思います。 ・パターンにかっこを付けることで、それぞれのマッチ部分文字列が取得できます。 （下記の$1,$2,$3がそれぞれの部分文字列を指します） ・そして、それらを置換後文字列に使うことができます。
と言われても、正規表現を知らない方にはわからないかもしれません。 参考程度に閲覧ください。 どなたか別の方の回答をお待ちください。
下記のコードはstr1をstr2に置換するプリミティブな例です。 HTMLテキストをstr1に見立てれば、同様にできるはずです。
Sub test()
Dim reg As Object
Set reg = CreateObject("VBScript.RegExp")
'正規表現の指定
With reg
.Pattern = "(width=')(\d+)(')" 'パターンを指定
.IgnoreCase = True '大文字と小文字を区別するか(False)、しないか(True)
.Global = True '文字列全体を繰り返し検索するか(True)、しないか(False)
End With
Dim str1 As String, str2 As String
str1 = "width='100', aaa,width='200', bbb"
str2 = reg.Replace(str1, "$1$2px$3") '指定した正規表現を第2引数の区切り文字に置換
Debug.Print str2 'width='100px', aaa,width='200px', bbb と出力されます。
End Sub
（γ） 2022/01/04(火) 18:50
HTMLでは px の単位は普通は指定しませんけど何か訳でもあるのですか。 （nm） 2022/01/04(火) 19:14
＞寒さん、γさん
正規表現を使うことで特定の部分を置換することができるのですね。
実際にサンプルを動かしてみましたが、イメージ通りのものになりそうです。
これをもとに作成していきたいと思います。ありがとうございます。
＞nmさん
IEからEdgeの移行でwidthやheightにpx指定をしないと効かなくなってしまったので、その対応をしないといけなくなったのでこのような置換プログラムを作成することになりました。
（名無し） 2022/01/05(水) 08:56
>widthやheightにpx指定をしないと効かなくなってしまったので 「効かなくなってしまった」とはどういうことですか。
移行前の構文はどうなっているのでしょう。
（nm） 2022/01/05(水) 11:19
> IEからEdgeの移行でwidthやheightにpx指定をしないと効かなくなってしまったので、
もし、そんなことがあったら、世界中で大パニックになってます。 （hatena） 2022/01/05(水) 13:10
＞nmさん、hatenaさん
有識者に聞いたところ、意味のない作業になりそうです・・・
発見した人の発言力が強いため、間違いを指摘できなかったそうです。
なにか根拠があるのかどうかわからないのですが、ただ従っているだけの状況です・・・
（名無し） 2022/01/05(水) 14:44
Dim wb As Workbook
Dim ws, outputSheet As Worksheet
Dim filePath, replaceWord As String
Dim rng, searchRng As Range
Dim firstAddress As String
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet
Set outputSheet = wb.Sheets(2)
filePath = ws.Range("D4").Value
Dim fso As Object, buf As String
Set fso = CreateObject("Scripting.FileSystemObject")
'C:\Work\Sample.txtの全ての文字を読み込んで表示します
With fso.GetFile(filePath).OpenAsTextStream
buf = .Readall
MsgBox buf
Dim reg As Object
Set reg = CreateObject("VBScript.RegExp")
'正規表現の指定
With reg
.Pattern = "(width=')(\d+)(')" 'パターンを指定
.IgnoreCase = True '大文字と小文字を区別するか(False)、しないか(True)
.Global = True '文字列全体を繰り返し検索するか(True)、しないか(False)
End With
Dim str1 As String, str2 As String
str1 = buf
MsgBox buf
str2 = reg.Replace(str1, "$1$2px$3")
.Write (str2)
End With
Set fso = Nothing
End Sub
（名無し） 2022/01/06(木) 10:05
を参照してください。
VBAのオブジェクトブラウザで見ると
Function OpenTextFile(FileName As String, [IOMode As IOMode = ForReading], [Create As Boolean = False], [Format As Tristate = TristateFalse]) As TextStream
となっているので、IOMode の既定値は ForReading です
読み込みと書き込みを同時にできるモードはないので、
いったん閉じてから、再度 IOMode を ForWriting で開き直すか
別のファイルに書き込むようにしてください。
（とおりすがり） 2022/01/06(木) 10:19
気のすすまない処理のようですが、一応コメントしておきます。
(1)元のファイルは残しておいて、修正済みのフォルダに別途保存するのがよいでしょう。 空のファイルで上書きしてしまうなどということが起きないとも限らないし、 よほど自信があれば別だが、元に戻せる余地は残すのが安全でしょう。 どうしても上書きというなら、結果が確認できてから、手作業でまとめて上書きすればよい。
(2)また、パターンの話ですが、 ・$1と$2は区別する必要は本来なかったですね。まあ分かりやすいかとは思ったわけですが。 ・'100' のほかに "100" と書く流儀もあるでしょう。それは組み込んでおきました。 ・このほか、途中に半角スペースが入るかもしれないので、 その冗長性も考えたほうがいいかもしれない。（まあ、形式的にやったことにするなら不要だが） ・CSSで幅指定することのほうがむしろ多いのではないかと想像します。 （まあ、徒に仕事を増やすので歓迎はされない指摘だが）
既にご指摘があったとおりです。 念のため、参考コードを挙げておきます。色々な書き方があります。一例です。
Sub mainTool()
Dim fso As Object
Dim reg As Object
Dim folder1 As String
Dim folder2 As String
Dim fname As String
Dim buf As String
Dim str2 As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set reg = CreateObject("VBScript.RegExp")
'正規表現の設定
With reg
.Pattern = "(width=['""]\d+)(['""])" 'パターンを指定
.IgnoreCase = True '大文字と小文字を区別しない
.Global = True '文字列全体を繰り返し検索
End With
folder1 = "D:\mydocuments\202201\test\" '■適宜修正下さい
folder2 = folder1 & "modified\" '■適宜修正下さい
fname = Dir(folder1 & "*.txt") 'htm(l) であれば "*.htm" とします。
Do While fname <> ""
'ファイル読み込み
With fso.GetFile(folder1 & fname).OpenAsTextStream
buf = .Readall
.Close
End With
'置換
str2 = reg.Replace(buf, "$1px$2")
'ファイル書き込み
With fso.CreateTextFile(folder2 & fname, True)'最後のTrueは強制上書き
.Write str2
.Close
End With
fname = Dir() '次のファイルのファイル名を取得
Loop
End Sub
（γ） 2022/01/06(木) 12:30
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.