ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 197|回复: 6

[求助] 求助,网页批量导入后长字段数字显示为15+E

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-3-14 21:29 | 显示全部楼层 |阅读模式

各位大虾求助,目前有100份左右的网页需要批量导入数据,导入的字段共有50列,其中有几列的字段内容以15位以上的数字,希望能得到各位大虾的相助,谢谢。

Sub main()
Dim url As String, mypath As String, fn As String
Rows("2:65536").Clear
mypath = ThisWorkbook.Path & "\"
fn = Dir(mypath & "*.ht*")
Do While fn <> ""
    url = "file:///" & Replace(mypath & fn, "\", "/")
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = Split(fn, ".")(0)
    提取数据 url, ActiveSheet
    fn = Dir()
Loop
If Sheets.Count > 1 Then
    For i = 2 To Sheets.Count
        Sheets(i).Activate
        Range("a1", Range("a65536").End(xlUp)).EntireRow.Copy Sheets(1).[a65536].End(xlUp).Offset(1, 0)
        Application.CutCopyMode = False
    Next
End If
Sheets("汇总").Activate
[a1].Select
End Sub
Sub 提取数据(url As String, sht As Worksheet)
Dim QT As QueryTable
Set QT = sht.QueryTables.Add(Connection:="Url;" & url, Destination:=sht.Range("a1"))
With QT
    .WebFormatting = xlWebFormattingAll
        .WebTables = "1"
    .WebSelectionType = xlSpecifiedTables
    .TextFileStartRow = 1
                         .TextFileConsecutiveDelimiter = True
                         .TextFileCommaDelimiter = True
                         .TextFileSpaceDelimiter = True
                       
  ' .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
   
    .Refresh
    .Delete
End With
End Sub

图片2.jpg

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-14 21:31 | 显示全部楼层
这是附件,跪求各位大虾的帮助。

网页批量导入数据.zip

72.87 KB, 下载次数: 2

TA的精华主题

TA的得分主题

发表于 2020-3-14 21:34 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-16 08:20 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-3-16 08:46 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-17 08:19 | 显示全部楼层
也是一样。

Sub main()
Dim url As String, mypath As String, fn As String
Rows("2:65536").Clear
  Columns(5).NumberFormatLocal = "@"
mypath = ThisWorkbook.Path & "\"
fn = Dir(mypath & "*.ht*")
Do While fn <> ""
    url = "file:///" & Replace(mypath & fn, "\", "/")
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = Split(fn, ".")(0)
    提取数据 url, ActiveSheet
    fn = Dir()
Loop
If Sheets.Count > 1 Then
    For i = 2 To Sheets.Count
        Sheets(i).Activate
        Range("a1", Range("a65536").End(xlUp)).EntireRow.Copy Sheets(1).[a65536].End(xlUp).Offset(1, 0)
           Application.CutCopyMode = False
    Next
End If
Sheets("汇总").Activate

[a1].Select
End Sub
Sub 提取数据(url As String, sht As Worksheet)
Dim QT As QueryTable
Set QT = sht.QueryTables.Add(Connection:="Url;" & url, Destination:=sht.Range("a1"))
With QT
    .WebFormatting = xlWebFormattingAll
        .WebTables = "1"
    .WebSelectionType = xlSpecifiedTables
    .TextFileStartRow = 1
                         .TextFileConsecutiveDelimiter = True
                         .TextFileCommaDelimiter = True
                         .TextFileSpaceDelimiter = True
        .Refresh
    .Delete
End With
End Sub

TA的精华主题

TA的得分主题

发表于 2020-3-17 08:44 来自手机 | 显示全部楼层
添加汇总数据用的是copy,会不会把原表的格式复制过来了,(没用过)。所有的数据添加完,再改格式试试吧
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2020-5-30 21:03 , Processed in 0.056260 second(s), 15 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表