You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

如何用Excel VBA从网页HTML提取指定字符串及左侧20字符?

Fixing Your VBA Code to Extract Target Substring with Left Context

Let's get your code working exactly as you need it—right now it's just grabbing the first 20 characters of the HTML, but we can adjust it to locate your target string and pull the 20 characters before it plus the string itself.

Key Issues with the Original Code

  • You're using Left(strMyPage, 20) which only ever gets the first 20 characters, no matter where your target string is.
  • No logic to find the position of your target string (s = ActiveCell.Offset(0,1).Value) in the HTML content.

Modified Code with Explanations

Here's the updated version that does what you want, plus some robustness improvements:

Sub String_Checker()
    Dim IE As Object
    Dim objDoc As Object
    Dim strMyPage As String
    Dim s As String
    Dim pos As Long
    Dim startPos As Long
    Dim targetCell As Range
    
    ' Start at A2 on Sheet1
    Set targetCell = Sheets("Sheet1").Range("A2")
    
    ' Create IE object once outside the loop (more efficient)
    Set IE = CreateObject("internetexplorer.Application")
    IE.Visible = True ' You can set this to False if you don't need to see the browser
    
    Do Until IsEmpty(targetCell)
        s = targetCell.Offset(0, 1).Value
        If s <> "" Then ' Only proceed if there's a target string to look for
            IE.navigate "https://website.com"
            
            ' Wait for the page to fully load
            Do Until (IE.readyState = 4 And Not IE.Busy)
                DoEvents
            Loop
            
            Set objDoc = IE.document
            strMyPage = objDoc.body.innerHTML
            
            ' Find the position of the target string (case-insensitive search)
            pos = InStr(1, strMyPage, s, vbTextCompare)
            
            If pos > 0 Then
                ' Calculate start position: if target is within first 20 chars, start at 1
                startPos = IIf(pos <= 20, 1, pos - 20)
                ' Extract 20 chars before target + the target itself
                targetCell.Offset(0, 2).Value = Mid(strMyPage, startPos, 20 + Len(s))
            Else
                ' If target string isn't found, add a note
                targetCell.Offset(0, 2).Value = "Target string not found"
            End If
        Else
            ' If no target string in column B, leave column C blank or add note
            targetCell.Offset(0, 2).Value = "No target string specified"
        End If
        
        ' Move to next row
        Set targetCell = targetCell.Offset(1, 0)
    Loop
    
    ' Clean up IE object
    IE.Quit
    Set IE = Nothing
    Set objDoc = Nothing
End Sub

What Changed & Why

  • Moved IE object creation outside the loop: This is more efficient than creating a new IE instance every row.
  • Added InStr to locate the target string: InStr(1, strMyPage, s, vbTextCompare) finds the first occurrence of your target string. Use vbBinaryCompare instead if you need case-sensitive matching.
  • Calculated the correct start position: startPos ensures we don't try to access a negative index if the target string is in the first 20 characters.
  • Used Mid instead of Left: Mid(strMyPage, startPos, 20 + Len(s)) pulls exactly the 20 characters before the target plus the target string itself.
  • Added error handling for missing targets: Now you'll get clear feedback if the target string isn't found or isn't specified.
  • Replaced Select with direct range references: Using targetCell instead of ActiveCell makes the code more reliable (selecting cells can cause issues if the user clicks elsewhere while the macro runs).

Example Behavior

If your HTML contains "Lorem ipsum dolor sit amet, consectetur adipiscing elit" and your target string is "elit":

  • pos will be the position of "elit" in the HTML.
  • startPos will be pos - 20 (since "elit" is well past the first 20 characters).
  • The extracted substring will be "sectetur adipiscing elit" (20 characters before "elit" plus "elit" itself).

内容的提问来源于stack exchange,提问作者Learner04390

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.05.09 14:02:28