Question

我有一个包含以下“字段”的点列表（列中的每个字段，B到G）：

点名称（B），东区（C），北区（D），调查队（E），调查日期（F），调查方法（G）

用户必须输入
调查船员（H2）
调查日期（I2）
调查方法（J2）
线（H4）点的名称第一部分
开始（I4）
结束（J4）

我想要：
- 检查点是否存在 - 如果该点存在并且“fields”为空，则填充用户必须在某些特定单元格中输入的信息
- 如果已填充单元格以检索信息以在其他一些单元格中显示该信息我来到这些代码行并且它们可以工作，但检查过程需要很长时间。

有谁能帮助我弄清楚如何更快地做到这一点？因为每次执行检查都需要很长时间。

我对此不太满意，我认为有一种更快的方法可以做到这一点;欢迎提出任何意见或建议

    Sub CheckProd()
    Dim FR1, Bin, Track, Min, MinBin, Max, MaxBin, Tre As Integer
    Bin = 10 ^ Range("O2").Value
    Track = Range("H4").Value 'Input value (first part of the point name)
    MinBin = Range("I4").Value ' Input Value (second part of the point name - Start)
    MaxBin = Range("J4").Value ' Input Value (second part of the point name - End)
    If MaxBin > MinBin Then ' calculates first and last point to update
        Min = Bin * Track + MinBin
        Max = Bin * Track + MaxBin
        Else
        Min = Bin * Track + MaxBin
        Max = Bin * Track + MinBin
    End If
    Tre = Max - Min + 1 'Counts number of points to update
    FR1 = Range("B65536").End(xlUp).Row 'Counts total design points points
    Range("K2:M65536").ClearContents
    Check = Min - 1
    For i = 1 To Tre
        Check = Check + 1
        Find = False
        For J = 2 To FR1
            Station = Cells(J, "B").Value
            datte = Cells(J, "F").Value
            If (Check = Station) Then
                Find = True
                If IsEmpty(Cells(J, "F")) Then
                    Cells(J, "E").Value = Cells(2, "H").Value 'Updates Crew number
                    Cells(J, "F").Value = Cells(2, "I").Value 'Updates Survey Date
                    Cells(J, "G").Value = Cells(2, "J").Value 'Updates Survey Method
                Else
                    FRL = Range("K65536").End(xlUp).Row
                    Cells(FRL + 1, "K").Value = Station 'Shows the point already reported
                    Cells(FRL + 1, "L").Value = "Reportado" 'Shows the status "Reported"
                    Cells(FRL + 1, "M").Value = datte ' Shows the date when the point was reported
                End If
            End If
            If ((J = FR1) And (Not Find)) Then
                FRM = Range("K65536").End(xlUp).Row
                Cells(FRM + 1, "K").Value = Check 'Shows the point without design coordinates
                Cells(FRM + 1, "L").Value = "No Preplot" 'Shows the status "No Preplot"
            End If
            If (Find) Then J = FR1
        Next J
    Next i
End Sub

Answer 1

For循环的所有内容都将是超快的。很明显，速度命中在你的双For循环中。

   For i = 1 To Tre
        Check = Check + 1
        Find = False
        For J = 2 To FR1
              'performance problem happens here...
        Next J
    Next i

代码并不是非常糟糕。

但很明显，您正在通过大量数据进行查找。通过长循环执行这么多次并不是很好，因为您基本上通过大量迭代不断地检查单个单元格值以获得很少的好处（即查找3个值）。

相反，考虑用一个VLookup（）或Index（Match（））函数替换这个“搜索算法”，该函数使用Cells（J，“B”）中的值。值在Cells中找到3个值（2，“ H“）。值，单元格（2，”I“）。值和单元格（2，”J“）。值。

更好的涉及代码的方法是在开始时将所有值读入数组。为此，首先将数据加载到数组中。好的，你现在不再浪费时间与Excel交谈了。

Dim arr()
arr = Range("H2:J666").Value2

现在重新编写“搜索算法”来处理这个数组。为此，您将重建For循环以迭代变量arr的元素和维度。即。

For rowCount = 0 to 664
   For columnCount = 0 to 2
       If arr(rowCount, columnCount) = CheckValue(GetStationValue(station)) Then
             ' we have found the correct set of values
             Range("E" & J).Value = arr(rowCount,columnCount)
             Range("F" & J).Value = arr(rowCount,columnCount)
             Range("G" & J).Value = arr(rowCount,columnCount)
        Else
              ' do other update of data
        End If
    Next
Next

'其中GetStation值只是一个单独的函数，用于根据原始站变量值获取动态“站”值（如果需要更新此值，则使用全局变量），然后CheckValue将此值与Check值进行比较你正在使用。

希望这会有所帮助。

检查值并在Excel中填充单元格

1 个答案: