时间戳

首页 > 解决方案 > 调整范围和转置数组时出现错误 1004

excel - 调整范围和转置数组时出现错误 1004

问题描述

我不会发布完整的代码，因为它非常庞大 - 我将专注于导致错误的部分。

该宏应该复制在 excel 中生成的 URL，在 IE 中打开它们，将源代码复制到另一个工作表，在此代码中查找内容，将结果保存在特定单元格中，删除工作表并转到下一个 URL。它工作得很好，它复制了许多 URL 的源代码，但对于某些 URL，它只是失败了。当我手动打开 URL 时 - 它们运行良好，但 Excel 以某种方式向我抛出了错误。

你们能否检查以下内容以帮助我更好地了解问题出在哪里？

以下是两个示例链接：

这个效果很好 - link1 这个抛出错误 1004 - link2

这是代码：

    Sub CC_Check()

Dim ie As InternetExplorer
Dim html As HTMLDocument

Dim URL As Range
Dim Rng As Range
Dim ws1 As Worksheet

Set ws1 = Worksheets("One Code")

Set ie = New InternetExplorer

Set Rng = ws1.Range("A3:A18")

For Each URL In Rng

ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = ws1.Cells(URL.Row, 2).Value & "_" & ws1.Cells(6, 7).Value

ie.Visible = False
ie.navigate URL.Value

Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop

Set html = ie.document

Range("A1").Value = html.DocumentElement.outerHTML

Dim arr

arr = Split(html.DocumentElement.outerHTML, vbLf)

Range("A1").Resize(UBound(arr) + 1, 1).Value = Application.Transpose(arr) '<-- this line causing error 1004

标签： excelvba

解决方案

有Application.Transpose很多问题。它失败时

  • 该数组只有一个成员 ( UBound(arr) = 1)
  • 其中一个字符串的长度 > 32K（但我见过其他情况，当字符串超过 255 个字符时它已经失败）
  • 数组大小大于 64K（但是，在 Excel 2016 中，这不会导致运行时错误，而是会导致大小较小的残缺数组

因此，下注是手动进行转换，这很容易。顺便说一句，您应该Worksheet为您添加的工作表使用 - 变量 - 永远不要依赖Activesheet. 以下代码仅在不存在时创建新工作表（否则它将清除其内容，以便您可以多次运行代码

Set newWs = Nothing
On Error Resume Next
Set newWs = ThisWorkbook.Sheets(wsName)
On Error GoTo 0
If newWs Is Nothing Then
    ' Sheet doesn't exist, create a new one and name it
    Set newWs = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
    newWs.Name = ws1.Cells(URL.row, 2).Value & "x" & ws1.Cells(6, 7).Value
Else
    ' Sheet already there, clear its content
     newWs.UsedRange.ClearContents
End If

    (..Load HTML and split..)

' Do your own transpose into a 2nd array and dump that into sheet
Dim brr
ReDim brr(LBound(arr) To UBound(arr), 1 To 1)  ' Make it 2-dimensional
Dim i As Long
For i = LBound(arr) To UBound(arr)
    brr(i, 1) = arr(i)
Next i
Range("A1").Resize(UBound(arr) + 1, 1).Value = brr

推荐阅读