我有一个包含以下“字段”的点列表(列中的每个字段,B 到 G):
点名称 (B)、东距 (C)、北距 (D)、测量人员 (E)、测量日期 (F)、测量方法 (G)
用户必须输入
测量人员 (H2)
测量日期 (I2)
测量方法 (J2)
线 (H4) 点名称 第一部分
开始 (I4)
结束 (J4)
我想要:
- 检查点是否存在
- 如果点存在并且“字段”为空,则使用用户必须在某些特定单元格中输入的信息填充它们
- 如果单元格已经填充以检索信息以显示它在其他一些单元格中
,我来到了这些代码行并且它们可以工作,但是检查过程需要太长时间。
谁能帮我弄清楚如何更快地做到这一点?因为每次执行检查都需要很长时间。
我对此不太擅长,我认为可能有一种更快的方法来做到这一点;欢迎任何意见或建议
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