校验值和填充细胞在Excel

我有下面的“田”点的列表（每场一列中，B到G）：校验值和填充细胞在Excel

点名称（B），东（C），北（d），测量人员（E），调查（F）日期，调查方法（G）

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

而且我想：
- 检查点存在
- 如果点存在与“域”是空的，用户在某些特定细胞
到iput的信息填充它们 - 如果单元格已经填充以检索信息以在其他一些单元格中显示它
我来到这些代码行，它们工作但检查过程花费太长时间。

任何人都可以帮我弄清楚如何更快地做到这一点吗？因为每次执行检查都需要很长时间。

我不擅长这一点，我想可能有一种更快的方法来做到这一点;任何意见或建议是值得欢迎的

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

来源

2013-05-30 Gurato

一切都达到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（））函数替换这个“搜索算法”，该函数使用单元格中的值（J，“B”）来查找单元格中的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值只是一个单独的函数来获得在原有基础上站变量值动态‘站’值（使用全局变量，如果你需要更新此值），以及校验值然后比较这到您正在使用的检查总和。

希望这有助于。

来源

2013-05-31 00:05:06

校验值和填充细胞在Excel

回答

相关问题