0

解決すべき次の問題があります。

3列29000行のExcelシートがあります。

列aはインデックス番号です。

列bはID番号です。

列cは、列aのインデックスを指す数値です。

したがって、列cが200の場合、列a 200に移動し、列b idを取得して、列cのインデックスと同じ行に配置する必要があります。

これの目的は、この列cによってリンクされている2つのアイテムのID番号をリンクすることです。

（私は理にかなっていると思います：/）

だから私はこれをVBAでコーディングしようとしています。現時点では、ネストされたforループを使用していますが、ご想像のとおり、実行時間はかなり長くなっています。

dim i as integer
dim v as integer
dim temp as integer
i = 1
v=1

for i = 1 to 29000
   if cells(i,3).value > 0 then
    temp = cells(i,3).Value
     cells(i,5).value = cells(1,2).value
     for v = 1 to 29000
       if cells(v,1).value = temp and cells(i,5).value <> cells(v,2).value then
            cells(i,6).value  = cells(v,2).value
       end if
      next
    end if
 next

したがって、それは機能し、私が望むことを実行しますが、実行時間は長すぎます。プログラムを合理化する方法はありますか？

私はvbaとプログラミング全般にかなり慣れていません。

前もって感謝します

4

1 に答える 1

0

テストされていませんが、コンパイルはOKです

Sub Test()

Dim dict As Object
Dim i As Long
Dim temp As Long
Dim sht As Worksheet
Dim oldcalc

    Set sht = ActiveSheet
    Set dict = GetMap(sht.Range("A1:B29000"))

    With Application
        .ScreenUpdating = False
        oldcalc = .Calculation
        .Calculation = xlCalculationManual
    End With

    For i = 1 To 29000
       If Cells(i, 3).Value > 0 Then
            temp = Cells(i, 3).Value
            Cells(i, 5).Value = Cells(1, 2).Value
            If dict.exists(temp) Then
               If sht.Cells(i, 5).Value <> dict(temp) Then
                   sht.Cells(i, 6).Value = dict(temp)
               End If
            End If
        End If
     Next

     With Application
        .ScreenUpdating = True
        .Calculation = oldcalc 'restore previous setting
     End With

End Sub

Function GetMap(rng As Range) As Object
    Dim rv As Object, arr, r As Long, numRows As Long
    Set rv = CreateObject("scripting.dictionary") 'EDITED to add Set
    arr = rng.Value
    numRows = UBound(arr, 1)
    For r = 1 To numRows
        If Not rv.exists(arr(r, 1)) Then
            rv.Add arr(r, 1), arr(r, 2)
        End If
    Next r
    Set GetMap = rv
End Function
于 2012-07-20T18:14:42.607 に答える