Question

我不知道我在做什么，如果你想对我大喊大叫那么酷。

我想知道如何根据文本文件ItemNumber.txt中的值检查名为PriceList的工作表中D列中每个单元格的值。

如果列中单元格的内容等于所述文本文件中的一个值，我希望它复制该行并将其粘贴到sheet1 ....

End Sub

Answer 1

试试这个：

Sub CompareValue()
Dim mainWS As Worksheet, dataWS As Worksheet, txtWS As Worksheet
  Dim FileNum&, i&, j&
  Dim DataLine As String, celString$
  Dim cel As Range, myRange As Range
  Dim ranOnce As Boolean

  ranOnce = False ' Check if we've added a line to your new sheet


  Dim fileName$, filePath$, fullFile$
  filePath = "C:\Users\bWayne\"
  fileName = "myTextDoc.txt"
  fullFile = filePath & fileName

    Set dataWS = Sheets("Data") ' Rename this, this sheet has your column D with the values to check
    Set mainWS = Sheets("Sheet1") ' This is where the row from DATA will be copied to, if a match is found in the text file.

    ' This will call a sub that will put the text into the temp sheet
    TextFile_PullData fullFile, mainWS
    Set txtWS = Sheets(Left(fileName, WorksheetFunction.Search(".", fileName) - 1))

' Now we have the text file informaiton in a sheet. So just loop through the cells in "Data" and check if there's a match in the text
Dim lastRow&
lastRow = dataWS.Cells(dataWS.Rows.Count, 4).End(xlUp).Row
Set myRange = dataWS.Range("D1:D" & lastRow) ' edit this as necessary
For Each cel In myRange
    If WorksheetFunction.CountIf(txtWS.Range("A1:A" & txtWS.UsedRange.Rows.Count), cel.Value) > 0 Then
        ' Since we found a match, copy the entire row to "Sheet1"
        Dim newLastRow&
        newLastRow = mainWS.Cells(mainWS.Rows.Count, 4).End(xlUp).Row

        If ranOnce Then newLastRow = newLastRow + 1
        ranOnce = True
        mainWS.Rows(newLastRow).EntireRow.Value = cel.EntireRow.Value
    End If
Next cel

End Sub
Sub TextFile_PullData(fileName As String, mySheet As Worksheet)

Workbooks.OpenText fileName:=fileName, _
        Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True

ActiveSheet.Copy after:=mySheet

End Sub

我没有逐行，而是将文本文件导入Excel，我只是在做CountIf()以查看是否匹配。如果是这样，请将该行复制到新工作表中。请注意，您可能希望更改表格，因为我不清楚您希望数据输入的位置。这应该有助于你走！我建议单步执行 F8 以确保它有效。

编辑：你在那里有一些我可能没有考虑的循环，所以如果我错过了什么，请告诉我。

将列单元格内容与文本文件进行比较，并将匹配的行复制到另一个工作簿VBA

1 个答案: