我的代码的目标是在excel列中创建一个值数组，并检查每个值是否在文本文件中找到。一个消息框将显示找到了哪些值，以及哪些值需要添加到文本文件中。数组idxArr包含要检查的文本文件值（通过行输入读取）。我想解析文本文件，并将找到的所有元素添加到foundIdx数组中。当前，我的代码正在读取文本文件的每一行，如果未找到idxarr的任何成员，它将返回到Do while语句，该语句将我的foundIdx数组重置为0。我尝试更改范围of countf = 0，但似乎无法使代码正常工作。关于如何正确创建此引用数组的任何想法？主要子菜单下面的函数在我的电子表格中创建了一个值数组，并检查该值中是否已存在一个数组，以便填充文本文件中找不到的另一个值数组。
下面的代码：
Dim txtfilename As String, devpath As String, TextLine As String
Dim idxsource As Workbook
Dim lenRange As Range, idxRange As Range
Dim lenCount As Integer, Count As Integer
Dim idxArr As Collection
Dim blnFound As Boolean
Dim foundIdx() As Variant
Dim missngIdx() As Variant
Dim countf As Long
Dim countm As Long
txtfilename = ThisWorkbook.Sheets(1).Range("Txtfile_name")
Set idxsource = Workbooks.Open("filepath" & txtfilename & "\" & txtfilename & "_qualifier.xlsx")
Set lenRange = idxsource.Sheets(1).Columns(1)
lenCount = Application.WorksheetFunction.CountA(lenRange)
Set idxRange = idxsource.Sheets(1).Range("T2:T" & lenCount)
Set idxArr = GetIndices(idxRange.Value)
devpath = text file path
Open devpath For Input As #1
Do Until EOF(1)
Line Input #1, TextLine
Text = Text + TextLine
countf = 0
For Each UIndex In idxArr
If UIndex = "" Then GoTo NextUIndex
If InStr(1, TextLine, UIndex, vbBinaryCompare) > 0 Then
blnFound = True
' Assign any Indices found into an array
If blnFound = True Then
ReDim foundIdx(countf)
foundIdx(countf) = UIndex
countf = countf + 1
End If
End If
NextUIndex:
Next UIndex
Loop
Close #1
countm = 0
For Each LIndex In idxArr
If LIndex = "" Then GoTo NLIndex
If IsInArray(LIndex, foundIdx) = True Then 'GoTo NLIndex Else
ReDim Preserve missngIdx(countm)
missngIdx(countm) = ""
countm = countm + 1
Else:
ReDim Preserve missngIdx(countm)
missngIdx(countm) = LIndex
countm = countm + 1
End If
NLIndex:
Next LIndex
' Print found Indices
For i = LBound(foundIdx) To UBound(foundIdx)
msg = msg & foundIdx(i) & vbNewLine
Next i
MsgBox "Validated the following indices: " & vbNewLine & msg
' Print missing Indices
If missngIdx(0) = "" Then
'If IsEmpty(missngIdx) = True Then
MsgBox "All indices have been found!"
Else
For i = LBound(missngIdx) To UBound(missngIdx)
msg1 = msg1 & missngIdx(i) & vbNewLine
Next i
MsgBox "The following indices need to be added to the text file: " & vbNewLine & msg1
End If
End Sub
Public Function GetIndices(ByVal IndexRange As Variant) As Collection
' Objective is to input the Range where indices are located and create an array of unique values to use for looking through the ci
' to validate that all indices have been entered into the cdi
Dim Indices As Collection
Dim cellValue As Variant
Dim cellValuetrimmed As String
Set Indices = New Collection
Set GetIndices = Indices
On Error Resume Next
' 1. Trim values in range and skip empty cells.
' 2. Add values into the Indices Collection. "Contains" function will check the collection
' to look for duplicates
For Each cellValue In IndexRange
cellValuetrimmed = Trim(cellValue)
If cellValuetrimmed = "" Then GoTo NextValue
If Contains(Indices, cellValuetrimmed) = True Then GoTo NextValue
Indices.Add cellValuetrimmed
NextValue:
Next cellValue
On Error GoTo 0
End Function
Public Function Contains(Col As Collection, key As Variant) As Boolean
Dim obj As Variant
Dim i As Integer
Dim ret As Boolean
On Err GoTo Err
For i = 1 To Col.Count
If Col(i) = key Then
ret = True
Exit For
End If
Next i
Contains = ret
Exit Function
Err:
Contains = False
End Function
Public Function IsInArray(val As Variant, arr As Variant) As Boolean
Dim element As Variant
On Error GoTo ArrErr:
For Each element In arr
If element = val Then
IsInArray = True
Exit Function
End If
Next element
Exit Function:
ArrErr:
On Error GoTo 0
IsInArray = False
End Function