Question

以下代码打开.csv文件，在col B中找到“Trimmed Mean”，使用“Trimmed Mean”行作为起点，在B列中查找下一个“NC”值，并将一个单元格的值复制到“NC”对执行代码的工作簿的权利（Sheet 1 col A）。

问题是代码运行但该值未复制到sheet1。这可能只是一件小事，但我无法弄清楚那是什么。谢谢你的帮助。

Activities

Answer 1

阅读上面的评论并查看我发送的链接。

我编辑了您的代码以限定所有对象，并直接使用每个预期的对象。通过这种方式，您可以确保您的代码每次都会对您想要的完全对象起作用。

您可以通过行的'***来定义我编辑的行。

Const delim = vbTab  'for TAB delimited text files

Sub ImportMultipleTextFiles()

Dim wb As Workbook, wbThis As Workbook '***
Dim wsCopy As Worksheet, wsPaste As Worksheet '***
Dim sFile As Variant
Dim LastRow As Long
Dim rngCell As Range
Dim varMyItem As String

Set wbThis = ThisWorkbook '***
Set wsPaste = wbThis.Sheets("Sheet1") 'change name as needed '***

varMyItem = "NC"

sFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select text file...")

Set wb = Workbooks.Open(Filename:=sFile)
Set wsCopy = wb.Sheets(1) '***

Application.ScreenUpdating = False

LastRow = wsCopy.Range("B" & Rows.Count).End(xlUp).Row '***
Debug.Print "LastRow = " & LastRow

Set aCell = wsCopy.Range("B1:B" & LastRow).Find(What:="Trimmed Mean", LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False) '***

Debug.Print "Trimmed Mean can be found in Row # " & aCell.Row
'wb.Sheets(1).Select '***

For Each rngCell In wsCopy.Range("B" & aCell.Row & ":B" & LastRow) '***
' Debug.Print ActiveSheet.Range("B" & aCell.Row & ":B" & LastRow)
    If InStr(rngCell, "NC") > 0 Then
        Debug.Print rngCell.Row
'
        rngCell.Offset(0, 1).Copy Destination:=wsPaste.Range("A" & wsPaste.Range("A" & wsPaste.Rows.Count).End(xlUp).Row + 1) '***

        Exit For
    End If
Next rngCell


wb.Close SaveChanges:=False

Set wb = Nothing

Application.ScreenUpdating = True

End Sub

如果找到匹配的文本，则将值复制到另一个工作簿

1 个答案: