html与已打开的excel表格的处理

喝酒的毛毛虫

想把本地一个html文件内的文本按照段落分别放到excel内指定位置，并执行一个宏test。个人感觉很难实现。请各位老师赐教。详细看附件。
html文件与excle的问题.rar (16.25 KB, 下载次数: 16)

2023-2-12 16:39 上传

点击文件名下载附件

lss001

参考以下附件……
htmlexcle.rar (17.22 KB, 下载次数: 10)

2023-2-12 20:34 上传

点击文件名下载附件

喝酒的毛毛虫

lss001 发表于 2023-2-12 20:33
参考以下附件……

1. Dim regEx As Object, ar, i&
   
2.     Set regEx = CreateObject("Vbscript.RegExp")
   
3.         regEx.Pattern = "\d+[、\.．，)]"
   
4.     ar = Range("C1", Cells(Rows.Count, "C").End(3))
   
5.     For i = 1 To UBound(ar)
   
6.        ar(i, 1) = regEx.Replace(ar(i, 1), "")
   
7.     Next i
   
8.     Set regEx = Nothing
   
9.     Columns(3).Clear
   
10.     [C1].Resize(UBound(ar)) = ar

复制代码

请大神帮忙执行这个宏，谢谢。

lss001

喝酒的毛毛虫 发表于 2023-2-12 21:11
请大神帮忙执行这个宏，谢谢。

把以上代码加入附件模块中的以下位置即可
Public Sub TEXT()


    '加入此处
End Sub

smsn

1 读取html文本文件
2 使用 CreateObject("HTMLFILE") 解析到表格，条件是你的html格式固定。
能说下为什么要这样吗，可能还有其他比较好的方法

喝酒的毛毛虫

smsn 发表于 2023-2-13 00:45
1 读取html文本文件
2 使用 CreateObject("HTMLFILE") 解析到表格，条件是你的html格式固定。
能说下为什 ...

都是统一格式的，和附件一样。因为公司做舆情监测。要提取相关的内容。请老师不吝赐教。

smsn

1. Sub test()
   
2.     '声明变量
   
3.     Dim fd As FileDialog '文件选择器对象
   
4.     Dim f As Variant '文件名变量
   
5.     Dim ad As Object 'ADODB.Stream对象
   
6.     Dim html As Object 'htmlfile对象
   
7.     Dim p As Object 'p标签对象
   
8.     Dim i As Long '循环变量
   
9.     Dim c As Long '列变量
   
10.    
    
11.     '创建文件选择器对象
    
12.     Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
13.    
    
14.     '设置文件选择器属性
    
15.     fd.AllowMultiSelect = True '允许多选
    
16.     fd.Title = "请选择html文件" '标题
    
17.     fd.Filters.Clear '清除过滤器
    
18.     fd.Filters.Add "HTML文件", "*.html" '添加过滤器
    
19.    
    
20.     '显示文件选择器
    
21.     If fd.Show = -1 Then '如果用户点击确定
    
22.         c = 3 '设置列为C
    
23.         For Each f In fd.SelectedItems '遍历每个选中的文件
    
24.             '创建ADODB.Stream对象
    
25.             Set ad = CreateObject("ADODB.Stream")
    
26.             '设置ADODB.Stream属性
    
27.             ad.Type = 2 '文本类型
    
28.             ad.Charset = "utf-8" '编码为utf-8
    
29.             ad.Open '打开
    
30.             ad.LoadFromFile f '加载文件
    
31.             '创建htmlfile对象
    
32.             Set html = CreateObject("htmlfile")
    
33.             '设置htmlfile属性
    
34.             html.write ad.ReadText '写入文本
    
35.             ad.Close '关闭
    
36.             '遍历htmlfile对象中的所有p标签
    
37.             For Each p In html.getElementsByTagName("p")
    
38.                 '将p标签的文本写入C列
    
39.                 Cells(i + 1, c).Value = p.innerText
    
40.                 '增加行变量
    
41.                 i = i + 1
    
42.             Next p
    
43.         Next f
    
44.     Else '如果用户点击取消
    
45.         MsgBox "你没有选择任何文件" '显示消息框
    
46.     End If
    
47. End Sub

复制代码

完全bing ai写的，测试通过。