Question

我有一个VBA宏，它使用Microsoft MapPoint计算电子表格中每条记录的两个位置之间的距离。我有大约120,000条记录需要处理。该程序平稳运行大约10,000次迭代然后返回类型不匹配错误，我在错误处理程序中定义MapPoint位置。此时，我选择'Debug'，然后在不编辑任何代码的情况下继续执行，并且在再次发生同样的事情之前，它将成功运行另外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

您正在构建一个有点复杂的范围对象（Range - ＆gt; Offset - ＆gt; Item）。 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。所有其他结果应该给出一些结果的错误。请注意，您现有的代码可以找到（例如）不明确的结果，即使第一个结果不太可能是正确的结果。它也可能匹配State或Zipcode（因为这是它能找到的最好的），它会给你一个错误的结果。使用ResultsQuality，您可以检测到这一点。

我仍会检查Count的值作为额外的检查。

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

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

2 个答案: