Excel 代码无法在VBA中的特定列中查找字符串

出于测试目的，我们需要在航路点ID处输入一个值。然后我们需要按Save Record或Find Record。请看附图

问题1：子程序FindRecord不工作。宏分配FindRecord1

问题2：子程序SaveRecord也不工作。宏分配保存记录

附加名为“”的工作簿

编写用于查找字符串的VBA代码。我在观察工作表中的特定列“WayPointID”中找到一个字符串。WaypointID始终是唯一的

Sub FindRecord(WyPt)

Dim Value As String

WyPtRow = 0

ReadRow = 2
Value = Cells(ReadRow, 2).Select  'Observation Sheet-WayPointID

While Value <> ""
    
    If WyPt = Value Then
        
        WyPtRow = ReadRow
        Exit Sub
        
    End If
    
    ReadRow = ReadRow + 1
    Value = Cells(ReadRow, 2)
Wend

End Sub

---

---

如果观测工作表中存在航路点ID，则应说明数据已存在于保存记录子例程中，然后调用另一个子例程ReturnRecordFound，这基本上是将观测表中的数据粘贴到数据输入表单中。否则，如果不存在数据，则应添加新记录。

您的行

Value=Cells（ReadRow，2）。在
FindRecord
中选择
，将抛出运行时错误1004

无法分配
范围。请选择
方法给
字符串
变量

如果将
选择
更改为
值
，则会将单元格的值分配给变量
值

您应该考虑将变量名更改为VBA语言中不存在的名称。e、 g.
MyValue
而不是
Value


WyPtRow
不会在sub之间传递，因此除非它在某个地方声明为全局范围变量，
WyPtRow
在您使用它的每个过程中将
0
，
Nothing
，
Empty
或
”
（取决于它的数据类型）（因为您尚未为其指定任何值，所以在执行某些操作后的过程即将结束之前，请期待）

要么通过<代码> WPyTrw 回到您的其他过程，要么考虑赋予变量某种全局范围。< /P> < P>请尝试下一个解决方案。它使用函数而不是子和数组使代码更快：
Function FindRecord(WyPt As String) As Long
 Dim sh As Worksheet, arr, lastR As Long, i As Long

 Set sh = ActiveSheet 'use here your sheet. Maybe Worksheets("Observation Sheet-WayPointID")
 lastR = sh.Range("B" & sh.rows.count).End(xlUp).row
 arr = shrange("B2:B" & lastR).Value
 For i = 1 To UBound(arr)
     If arr(i, 1) = WyPt Then FindRecord = i + 1: Exit Function
 Next i
End Function

Sub FindRecord1(WyPt)
 Dim WyPt As String, DEFrm As Worksheet, WyPtRow As Long
 
 Set DEFrm = Worksheets("your necessary sheet(DEFrm)")
 WyPt = Trim(DEFrm.cells(6, 2).Value)
 WyPtRow = FindRecord(WyPt)

 If WyPtRow > 0 Then
    MsgBox "Data Already Exists in Observations Worksheet" ' Data Already Exists
 Else
    MsgBox "Data Does not exist in Observations Worksheet"
 End Sub

 Sub SaveRecord()
 Dim WyPt As String, DEFrm As Worksheet, WyPtRow As Long
 
 Set DEFrm = Worksheets("your necessary sheet(DEFrm)")
 WyPt = Trim(DEFrm.cells(6, 2).Value)

 WyPtRow = FindRecord(WyPt)
 If WyPtRow > 0 Then
    MsgBox "Data Already Exists in Observations Worksheet"
    Call ReturnFoundRecord(WyPtRow)        ' Data Already Exists
 Else
    Call AddNewRecord          'New Record
 End If
End Sub

请注意正确设置
DEFrm
工作表…
当您说它不工作时，您的意思是什么？您收到错误？没有发现任何内容？结果与预期不同？如果可能，您可以显示代码中的更改吗？？
Sub SaveRecord()

WyPt = Trim(DEFrm.Cells(6, 2))

Call FindRecord(WyPt)

If WyPtRow > 0 Then

    MsgBox "Data Already Exists in Observations Worksheet"
    Call ReturnFoundRecord(WyPtRow)        ' Data Already Exists
    
Else
    
    Call AddNewRecord          'New Record
    
End If        'WyPtRow > 0 Then
End Sub

Function FindRecord(WyPt As String) As Long
 Dim sh As Worksheet, arr, lastR As Long, i As Long

 Set sh = ActiveSheet 'use here your sheet. Maybe Worksheets("Observation Sheet-WayPointID")
 lastR = sh.Range("B" & sh.rows.count).End(xlUp).row
 arr = shrange("B2:B" & lastR).Value
 For i = 1 To UBound(arr)
     If arr(i, 1) = WyPt Then FindRecord = i + 1: Exit Function
 Next i
End Function

Sub FindRecord1(WyPt)
 Dim WyPt As String, DEFrm As Worksheet, WyPtRow As Long
 
 Set DEFrm = Worksheets("your necessary sheet(DEFrm)")
 WyPt = Trim(DEFrm.cells(6, 2).Value)
 WyPtRow = FindRecord(WyPt)

 If WyPtRow > 0 Then
    MsgBox "Data Already Exists in Observations Worksheet" ' Data Already Exists
 Else
    MsgBox "Data Does not exist in Observations Worksheet"
 End Sub

 Sub SaveRecord()
 Dim WyPt As String, DEFrm As Worksheet, WyPtRow As Long
 
 Set DEFrm = Worksheets("your necessary sheet(DEFrm)")
 WyPt = Trim(DEFrm.cells(6, 2).Value)

 WyPtRow = FindRecord(WyPt)
 If WyPtRow > 0 Then
    MsgBox "Data Already Exists in Observations Worksheet"
    Call ReturnFoundRecord(WyPtRow)        ' Data Already Exists
 Else
    Call AddNewRecord          'New Record
 End If
End Sub