0

存在一个 Excel 工作表,其中 Sheet1 的 A 列中包含机器名称列表。

存在一个文本文件,其中包含已退役机器的列表。

我需要在同一张表(Sheet1)B 列下的 Excel 表中将所有退役机器标记为“DECOM”。

这是我到目前为止所拥有的。

Sub ImportTextFileContents()
Dim strg As Variant
Dim EntireLine As String

FName = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Choose File to Import")

Open FName For Input Access Read As #1
i = 1
While Not EOF(1)
    Line Input #1, EntireLine
    strg = EntireLine

    If (Sheets("Sheet1").Range("A").Value = strg) Then
    Sheets("Sheet1").Range("B" & i).Value = "DECOM"
    End If

    i = i + 1
Wend
EndMacro:

On Error GoTo 0
Application.ScreenUpdating = True

Close #1
End Sub
4

1 回答 1

0

尝试这样的事情:

Sub ImportTextFileContents()
Dim strg As Variant
Dim EntireLine As String
Dim DecomMachines() as String
Dim rngExcel as Range
Dim cell as Range

FName = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Choose File to Import")

Open FName For Input Access Read As #1

'Create an array to contain the list of Decommissioned machines from the TXT file

i = 1
While Not EOF(1)
    Line Input #1, EntireLine
    strg = EntireLine
    ReDim Preserve DecomMachines(0 to i-1)
    DecomMachines(i-1) = strg   
    i = i + 1
Wend    

'Set the range variable over which we need to iterate:
Set rngExcel = Sheets("Sheet1").Range("A1",Range("A1").End(xlDown).Address)  '<-- modify as needed  

For each cell in rngExcel    
'Check to see if this cell.value exists in the array we built, above:
    If Not IsError(Application.Match(Cstr(cell.Value),DecomMachines,False)) Then
        'if the name exists in the DecomMachines array, then we need to mark it as decommissioned.
        cell.Offset(0,1).Value = "DECOM"
    Else:
        'it doesnot exist in the TXT file, so ignore it
    End If
Next    

EndMacro:

On Error GoTo 0
Application.ScreenUpdating = True

Close #1
End Sub

这将创建一个数组,其中包含 TXT 文件中标识的所有机器,然后遍历 A 列中的单元格范围,测试数组中是否存在每个单元格值。如果它确实存在,那么我们知道在 Bcell.Offset(0,1)列(

于 2013-02-13T22:21:03.637 回答