复制findstring1个单元格向下
我希望你能帮我解决一个VBA问题。
我的情况：我有多个txt文件作为search特定string（“tflux”）的input。 在每个txt文件中，string都存在，所以找不到它是不可能的。 我已经写了下面的代码，但我找不到一种方法来告诉excel复制与find的string相关的值后，必须将下一个find的值与下一个与其search的文件相关的值移动一个单元格。 虽然我还没有尝试，我也希望excel打印数字旁边的文件名，以确保值对应于某个文件名。
我的VBA代码到目前为止：
Sub CommandButton1_Click() Dim strF As String, strP As String, text As String, textline As String, tFlux As Integer strP = "C:\test" 'change for the path of your folder strF = Dir(strP & "\*.txt") 'Change as required Do While strF <> vbNullString Open strF For Input As #1 Do Until EOF(1) Line Input #1, textline text = text & textline tFlux = InStr(text, "tflux") Range("B2").Value = Mid(text, tFlux + 9, 3) <----- this is the line where I need help, Now the last found value is copied into cell B2, but I want excel to move to B3 after filling B2, move to B4 after filling B3, etc.... Loop Close #1 text = "" strF = Dir() Loop End Sub VBA皮特的答案将为每个find的值做所需的移动。 但是我想告诉你关于你的代码中另一个重要的问题：
Line Input #1, textline
text = text & textline
tFlux = InStr(text, "tflux")
上面的代码有两个问题。 首先，每次读取一行时，都会将其附加到文件中的前一个文本，然后从文件的开头重新开始search。 这很慢，而且是错误的，因为如果文件中出现了很多"tflux" ，你总能得到第一个出现。 即使只发生一次，你每次读新行时都会抓到并多次报告。
上面的第二行可以这样改写：
text = textline ' <-- just copy the line, don't append it to previous lines from the file
如果一个长整型variables每次在循环中移动一个值，那么该值如何变化：
Sub CommandButton1_Click() Dim strF As String, strP As String, text As String, textline As String Dim tFlux As Integer strP = "C:\test" 'change for the path of your folder Dim x as long strF = Dir(strP & "*.txt") 'Change as required Do While strF <> vbNullString x = 2 Open strF For Input As #1 Do Until EOF(1) Line Input #1, textline text = text & textline tFlux = InStr(text, "tflux") Range("B" & x).Value = Mid(text, tFlux + 9, 3) x = x + 1 Loop Close #1 text = "" strF = Dir() Loop End Sub
我会build议你重构你的代码，如下所示：
Sub CommandButton1_Click() Dim strF As String, strP As String, textline As String, tFlux As Integer Dim r As Long ' to keep track of which row we are writing to strP = "C:\test" 'change for the path of your folder strF = Dir(strP & "\*.txt") 'Change as required r = 2 ' first line of output will go to row 2 Do While strF <> vbNullString Open strF For Input As #1 Do Until EOF(1) Line Input #1, textline tFlux = InStr(textline, "tflux") 'See if we found "tflux" If tFlux > 0 Then 'Found it - store the associated value Cells(r, "B").Value = Mid(textline, tFlux + 9, 3) 'Store the filename too Cells(r, "C").Value = strF r = r + 1 ' set row pointer ready for next file Exit Do ' found and processed - no need to keep looking within this file End If Loop Close #1 strF = Dir() Loop End Sub
我在“读取文件”循环中包含了一个Exit Do ，因此只要find所要查找的信息，它就会退出循环。 这样可以节省时间，不必继续阅读文件的其余部分，find你不知道的东西。