创build一个循环，直到所有单元格都被脚本使用
我真的不知道如何编程，但是我已经编写了几个脚本来达到我想要的，但是在最后一步我失败了。
该脚本从单元格B2，表格2中的文件目录中打开一个.txt文件，并将其内容复制到excel（以及我不关心的记事本）中。
但是，我有120个文件目录我想要做这个。 目前我的脚本只是从B2单元中取得目录，我在B列下面有119个目录的其余部分，我运行脚本并删除行并重复，这有点费劲。
我只想让脚本自动运行B列中的所有120个文件。 任何帮助感激！
Option Explicit Sub ReadTxtFile() Dim start As Date start = Now Dim oFSO As Object Set oFSO = CreateObject("Scripting.FileSystemObject") Dim oFS As Object Dim filePath As String '''''Assign the Workbook File Name along with its Path filePath = Worksheets("Sheet2").Range("B2").Value MsgBox Worksheets("Sheet2").Range("B2").Value Dim arr(100000) As String Dim i As Long i = 0 If oFSO.FileExists(filePath) Then On Error GoTo Err Set oFS = oFSO.OpenTextFile(filePath) Do While Not oFS.AtEndOfStream arr(i) = oFS.ReadLine i = i + 1 Loop oFS.Close Else MsgBox "The file path is invalid.", vbCritical, vbNullString Exit Sub End If For i = LBound(arr) To UBound(arr) If InStr(1, arr(i), "Transmission", vbTextCompare) Then 'Declare variables for the new output file Dim sOutputFileNameAndPath As String Dim FN As Integer sOutputFileNameAndPath = "C:\Users\nfraser\Documents\test\second.txt" FN = FreeFile 'Open new output file Open sOutputFileNameAndPath For Output As #FN 'While 'end of report' has not been found, 'keep looping to print out contents starting from 'report' Do While InStr(1, arr(i), "Ancillary", vbTextCompare) = 0 Debug.Print i + 1, arr(i) Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1 Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i) 'Print into new output file Print #FN, i + 1 & " " & arr(i) 'increment count i = i + 1 Loop 'Print out the 'end of report' line as well Debug.Print i + 1, arr(i) Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1 Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i) 'Print 'end of report' line into new output file as well Print #FN, i + 1 & " " & arr(i) 'close the new output file Close #FN 'exit the 'For..Next' structure since 'end of report' has been found Exit For End If Next Debug.Print DateDiff("s", start, Now) Exit Sub Err: MsgBox "Error while reading the file.", vbCritical, vbNullString oFS.Close Exit Sub End Sub 为了快速行动，试试这个：
改变这一行：
filePath = Worksheets("Sheet2").Range("B2").Value
进入循环
Dim v As Variant, filepath As String For Each v In Worksheets("Sheet2").Columns("B").SpecialCells(xlCellTypeConstants) filepath = v.Value debug.Print filePath .... ' remainder of your code
然后转到Next行，然后写下另一条Next行。
您可以添加for... each循环，循环显示当前select中的所有单元格。 这里是模式：
Dim cCell as Range For Each cCell in Selection 'do stuff Next cCell
现在，由于您在整个代码中更改了select，所以必须将select开始时存储到另一个variables中，例如originalSelection ，然后循环遍历originalSelection的单元格。 否则，您的select将在执行期间改变。
调整它到您的代码，我们结束了以下…请注意：我把你的代码分为两个方法 – ReadTxtFiles和copyTo ; ReadTxtFile()子文件太长了。
Option Explicit Sub ReadTxtFiles() Dim start As Date start = Now Dim oFS As Object Dim inputFilePath As String Dim outputFilePath As String Dim outputDirectory As String outputDirectory = "C:\Users\nfraser\Documents\test\" '''''Assign the Workbook File Name along with its Path Dim originalSelection As Range Dim cCell As Range Dim i As Integer Set originalSelection = Selection For Each cCell In originalSelection inputFilePath = cCell.Value outputFilePath = outputDirectory & i & ".txt" copyTo inputFilePath, outputFilePath Next cCell Debug.Print DateDiff("s", start, Now) End Sub Sub copyTo(inputPath As String, outputPath As String) Dim arr(100000) As String Dim i As Long Dim oFSO As Object Set oFSO = CreateObject("Scripting.FileSystemObject") 'late binding Dim oFS As Object i = 0 If oFSO.FileExists(inputPath) Then On Error GoTo Err 'ensure oFS gets closed Set oFS = oFSO.OpenTextFile(inputPath) 'read file contents into array Do While Not oFS.AtEndOfStream arr(i) = oFS.ReadLine i = i + 1 Loop 'close oFS.Close Else 'file didn't exist MsgBox "The file path is invalid.", vbCritical, vbNullString Exit Sub End If For i = LBound(arr) To UBound(arr) If InStr(1, arr(i), "Transmission", vbTextCompare) Then 'Declare variables for the new output file Dim FN As Integer FN = FreeFile 'Open new output file Open outputPath For Output As #FN 'While 'end of report' has not been found, 'keep looping to print out contents starting from 'report' Do While InStr(1, arr(i), "Ancillary", vbTextCompare) = 0 Debug.Print i + 1, arr(i) Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1 Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i) 'Print into new output file Print #FN, i + 1 & " " & arr(i) 'increment count i = i + 1 Loop 'Print out the 'end of report' line as well Debug.Print i + 1, arr(i) Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1 Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i) 'Print 'end of report' line into new output file as well Print #FN, i + 1 & " " & arr(i) 'close the new output file Close #FN 'exit the 'For..Next' structure since 'end of report' has been found Exit For End If Next Exit Sub Err: MsgBox "Error while reading the file.", vbCritical, vbNullString oFS.Close Exit Sub End Sub