Question

我有一个电子表格，其中包含一列单元格，每列都包含几段文字。我正在尝试编写一个宏，它将在这些短语“我们如何做出决定”和“结论”之间抓取几句话

此文本字符串的位置因工作表而异，但列始终一致。

我已经能够找到一堆vba脚本，允许我一次查找和复制1个单词或单个单词的简单批次。我只是无法想象或找到允许我从段落的单个单元格中复制整个段落的东西。

下面的代码只是抓住了整个表格。正如你在开头部分所看到的，我能够得到我需要的东西但是我发现（70）是无关紧要的，因为表格大小随着记录的每次拉动而变化。

Sub GetTheData()
Dim T As String
 Dim SWs As New SHDocVw.ShellWindows
 Dim IE As SHDocVw.InternetExplorer
 Dim LetPr As InternetExplorer
 Dim Doc As HTMLDocument
'Dim IE As Object
 Dim tbls, tbl, trs, tr, tds, td, r, c

 For Each IE In SWs

    If IE.LocationName = "Letter Preparation Case Summary – Member Case"       Then
        Set LetPr = IE

        'LetPr.document.getElementById
        T = IE.document.getElementsByTagName("td")(70).innerText
        'T = Trim(Mid(T, InStr(T, "How We Made Our Decision: ") + 0, InStr(T, "Conclusion") - (InStr(T, "How We Made Our Decision:") + 26)))

          Exit For
    End If

Next
Set tbls = IE.document.getElementsByTagName("table")
For r = 0 To tbls.Length - 1
    Debug.Print r, tbls(r).Rows.Length
Next r

Set tbl = IE.document.getElementsByTagName("table")(9)
Set trs = tbl.getElementsByTagName("tr")

For r = 0 To trs.Length - 1
    Set tds = trs(r).getElementsByTagName("td")
    'if no <td> then look for <th>
    If tds.Length = 0 Then Set tds = trs(r).getElementsByTagName("th")

    For c = 0 To tds.Length - 1

        ActiveSheet.Range("A1").Offset(r, c).Value = tds(c).innerText
    Next c
Next r

 End Sub

Answer 1

您声明您希望这些文字短语＆＃39; 之间的文字，因此必须根据搜索到的字符串的长度调整找到的文字的起始位置。

dim beginStr as string, endStr as string, beginPos as long, endPos as long beginStr = "How We Made Our Decision:" endStr = "Conclusion" beginPos = instr(1, T, beginStr, vbtextcompare) endPos = instr(beginPos, T, endStr, vbtextcompare) if cbool(beginPos) and cbool(endPos) then beginPos = beginPos + len(beginStr) T = Trim(Mid(T, beginPos, endPos - beginPos)) end if

可能必须通过减去1来调整最后endPos - beginPos。

尝试编写Excel宏来查找大文本字符串并复制到另一个工作表

1 个答案: