3

我有一个 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
4

2 回答 2

3

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

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

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

Debug.Print objMap.FindResult(tmpR2).Count

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

于 2011-03-14T08:21:50.383 回答
1

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

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

Resultsquality 返回一个 GeoFindResultsQuality 枚举。您要检查值 geoAllResultsGood 和 geFirstResultGood。所有其他结果应该给出一些结果的错误。请注意，您现有的代码将适用于（例如）不明确的结果，即使第一个结果不太可能是正确的。它也可能与 State 或 Zipcode 匹配（因为这是它可以找到的最好的），这会给你一个错误的结果。使用 ResultsQuality，您可以检测到这一点。

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

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

于 2011-03-14T12:44:28.230 回答