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

lanjian168

各位大虾求助，目前有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

lanjian168

这是附件，跪求各位大虾的帮助。

YZC51

加一句
    Columns(5).NumberFormatLocal = "@"

lanjian168

YZC51 发表于 2020-3-14 21:34
加一句
    Columns(5).NumberFormatLocal = "@"

在什么位置加？

YZC51

在Rows("2:65536").Clear 之后

lanjian168

也是一样。

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

dysvip

添加汇总数据用的是copy，会不会把原表的格式复制过来了，（没用过）。所有的数据添加完，再改格式试试吧