3

Microsoft MapPoint を使用して、スプレッドシート内の各レコードの 2 地点間の距離を計算する VBA マクロがあります。処理するレコードが約 120,000 件あります。プログラムは約 10,000 回の繰り返しでスムーズに実行され、エラー ハンドラーで MapPoint の場所を定義する Type Mismatch エラーを返します。その時点で、[デバッグ] を選択し、コードを編集せずに実行を再開すると、同じことが再び発生する前に、さらに 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

1

MikeD は、あなたの危険な FindResults() 呼び出しについて正しいです。ただし、結果を確認するためのより良い方法があります。「FindResults コレクション」は純粋なコレクションではありませんが、「ResultsQuality」と呼ばれる追加のプロパティが含まれています。ドキュメントはここにあります：

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

Resultsquality は、GeoFindResultsQuality 列挙を返します。値 geoAllResultsGood と geFirstResultGood を確認します。他のすべての結果では、何らかの結果のエラーが発生するはずです。既存のコードは、最初の結果が正しい可能性が低い場合でも、(たとえば) あいまいな結果で find が機能することに注意してください。また、都道府県または郵便番号に一致する可能性があり (それが検出できる最良のものであるため)、誤った結果が得られます。ResultsQuality を使用すると、これを検出できます。

追加のチェックとして、Count の値を引き続きチェックします。

コードが直線 (大円) 距離を計算していることに注意してください。そのため、ボトルネックはジオコーディング (FindResults) になります。同じ場所を頻繁に使用している場合は、キャッシュ メカニズムを使用すると速度が大幅に向上する可能性があります。走行距離を計算したい場合は、市場に出回っている製品がたくさんあります (そうです、私はそのうちの 2 つを書きました!)。

于 2011-03-14T12:44:28.230 に答える