Excel VBA 中大约每 10,000 次迭代出现无法解释的类型不匹配错误

Question

我有一个 VBA 宏，它使用 Microsoft MapPoint 来计算电子表格中每条记录的两个位置之间的距离。我有大约 120,000 条记录需要处理。该程序顺利运行大约 10,000 次迭代，然后返回类型不匹配错误，我在错误处理程序中定义了 MapPoint 位置。此时，我选择“调试”，然后在不编辑任何代码的情况下恢复执行，并且在同样的事情再次发生之前，它将成功运行另外 10,000 条左右的记录。

我检查了我的数据，但我不明白为什么会出现类型不匹配，或者就此而言，为什么代码会在一条记录上阻塞一次，然后在不重置任何内容的情况下，在恢复时处理相同的记录。知道为什么会发生这种情况吗？

仅供参考，
- M 列包含“X County, ST”形式的位置
- AN 列包含一个单独的位置，如 ZIP
- G 列包含与 AN 相同的位置数据，但格式为“X County, ST”

Sub distance_from_res()
Dim oApp As MapPoint.Application
Dim k As Long  
Dim count As Long 
Dim errors As Long 

k = 0
count = Sheets("i1_20041").Range("A2", Sheets("i1_20041").Range("A2").End(xlDown)).count
errors = 0

  Set oApp = CreateObject("MapPoint.Application.NA.11")
  oApp.Visible = False
  Set objMap = oApp.NewMap
  Dim objRes As MapPoint.Location
  Dim objFish As MapPoint.Location

'Error executes code at 'LocError' and then returns to point of error.
  On Error GoTo LocError
  Do While k < count
    If Sheets("i1_20041").Range("M2").Offset(k, 0) <> "" Then
        'Sets MapPoint locations as [County],[State] from Excel sheet columns "INT_CNTY_ST" and "ZIP".
          Set objRes = objMap.FindResults(Sheets("i1_20041").Range("AN2").Offset(k, 0)).Item(1)
          Set objFish = objMap.FindResults(Sheets("i1_20041").Range("M2").Offset(k, 0)).Item(1)
        'Calculates distance between two locations and prints it in appropriate cell in Column AO.
          Sheets("i1_20041").Range("AO2").Offset(k, 0) = objRes.DistanceTo(objFish)
    Else
        errors = errors + 1
    End If
      k = k + 1
  Loop
 'Displays appropriate message at termination of program.
  If errors = 0 Then
    MsgBox ("All distance calculations were successful!")
  Else
    MsgBox ("Complete! Distance could not be calculated for " & errors & " of " & count & " records.")
  End If

Exit Sub

LocError:
    If Sheets("i1_20041").Range("G2").Offset(k, 0) = "" Then
        errors = errors + 1
    Else
        'THIS IS WHERE THE ERROR OCCURS!
          Set objRes = objMap.FindResults(Sheets("i1_20041").Range("G2").Offset(k, 0)).Item(1)
          Set objFish = objMap.FindResults(Sheets("i1_20041").Range("M2").Offset(k, 0)).Item(1)
        'Calculates distance between two locations and prints it in appropriate cell in Column AO.
          Sheets("i1_20041").Range("AO2").Offset(k, 0) = objRes.DistanceTo(objFish)
    End If
      k = k + 1
    Resume


End Sub

更新： 我采纳了 @winwaed 和 @Mike D 的大部分建议，现在我的代码更加准确，并且不会因错误而阻塞。然而，老问题又以新的形式出现了。现在，经过大约 10,000 次迭代后，代码会继续执行，但会为之后的每条记录打印大约 10,000 条记录的距离。我可以在故障点重新启动代码，它会正常找到这些记录的距离。为什么会出现这种情况呢？我在下面发布了更新的代码。

Sub distance_from_res()

Dim oApp As MapPoint.Application
Dim k As Long 
Dim rc As Long 
Dim errors As Long

Dim dist As Double
Dim zipRes As Range
Dim coRes As Range
Dim coInt As Range
Dim distR As Range

Set zipRes = Sheets("Sheet1").Range("C2")
Set coRes = Sheets("Sheet1").Range("B2")
Set coInt = Sheets("Sheet1").Range("E2")
Set distR = Sheets("Sheet1").Range("G2")

k = 0
rc = Sheets("Sheet1").Range("F2", Sheets("Sheet1").Range("F2").End(xlDown)).Count
errors = 0

'Start MapPoint application.
Set oApp = CreateObject("MapPoint.Application.NA.11")
oApp.Visible = False
Set objMap = oApp.NewMap
Dim objResultsRes As MapPoint.FindResults
Dim objResultsInt As MapPoint.FindResults
Dim objRes As MapPoint.Location
Dim objInt As MapPoint.Location

Do While k < rc
    'Check results for Res Zip Code.  If good, set first result to objRes.  If not, check results for Res County,ST.  If good, set first result to objRes.  Else, set objRes to Nothing.
    Set objResultsRes = objMap.FindResults(zipRes.Offset(k, 0))
    If objResultsRes.ResultsQuality = geoFirstResultGood Then
        Set objRes = objResultsRes.Item(1)
    Else
        Set objResultsRes = Nothing
        Set objResultsRes = objMap.FindResults(coRes.Offset(k, 0))
        If objResultsRes.ResultsQuality = geoFirstResultGood Then
            Set objRes = objResultsRes.Item(1)
        Else
            If objResultsRes.ResultsQuality = geoAmbiguousResults Then
                Set objRes = objResultsRes.Item(1)
            Else
                Set objRes = Nothing
            End If
        End If
    End If

    Set objResultsInt = objMap.FindResults(coInt.Offset(k, 0))
    If objResultsInt.ResultsQuality = geoFirstResultGood Then
        Set objInt = objResultsInt.Item(1)
    Else
        If objResultsInt.ResultsQuality = geoAmbiguousResults Then
            Set objInt = objResultsInt.Item(1)
        Else
            Set objInt = Nothing
        End If
    End If

    On Error GoTo ErrDist
    distR.Offset(k, 0) = objRes.DistanceTo(objInt)

    k = k + 1
Loop

Exit Sub


ErrDist:
    errors = errors + 1
    Resume Next

End Sub

Answer 1

您正在构造一个有点复杂的范围对象（范围 -> 偏移 -> 项目）。 DIM 临时范围对象并分步执行，以便您可以准确地了解问题发生的位置

tmpR1 = Sheets("i1_20041").Range("G2")
tmpR2 = tmpR1.Offset(k,0)

，然后在尝试访问 Item(1) 之前检查 .FindResult 的 .Count 属性 .... 也许该项目不存在？！？

Debug.Print objMap.FindResult(tmpR2).Count

暗示：
查看您的代码，我发现您使用了变量“count”。该变量名称与第二行代码中的“Count”属性重叠 - 这就是语句末尾的“Count”关键字全部小写的原因。它与错误没有任何关系（我们假装；-）），但无论如何风格都很糟糕。

Answer 2

MikeD 对危险的 FindResults() 调用的看法是正确的。但是，有更好的方法来检查结果。 “FindResults 集合”不是纯集合，而是包含一个名为“ResultsQuality”的额外属性。文档位于：

http://msdn.microsoft.com/en-us/library /aa493061.aspx

Resultsquality 返回 GeoFindResultsQuality 枚举。您想要检查值 geoAllResultsGood 和 geFirstResultGood。所有其他结果都应该给出某些结果的错误。请注意，您的现有代码可以使用（例如）模糊结果进行查找，即使第一个结果不太可能是正确的结果。此外，它可能会匹配州或邮政编码（因为这是它能找到的最好的），这会给您一个错误的结果。使用 ResultsQuality，您可以检测到这一点。

我仍然会检查 Count 的值作为附加检查。

请注意，您的代码正在计算直线（大圆）距离。因此，瓶颈将是地理编码（FindResults）。如果您经常使用相同的位置，那么缓存机制可以大大加快速度。
如果您想计算行驶距离，那么市场上有许多用于此目的的产品（是的，我写了其中两个！）。