Question

我有这个主要代码，该代码循环遍历包含文件的文件夹，并且从每个文件中提取字符串。

Option Explicit

Sub GenerateData()

    Application.ScreenUpdating = False

    Dim wks As Worksheet
    Dim wkb As Workbook
    Set wkb = ActiveWorkbook
    Set wks = wkb.Worksheets.Add(After:=wkb.Worksheets(wkb.Worksheets.Count), Type:=xlWorksheet)

    ' Add headers data
    With wks
        .Range("A1:K1") = Array("Test", "Start", "Temp", "Type", "FileName", "No", "End", _
        "Month", "Version", "Errors", "ErrorCellAddress")
    End With

    ' Early Binding - Add "Microsoft Scripting Runtime" Reference
    Dim FSO As New Scripting.FileSystemObject

    ' Set FolderPath
    Dim FolderPath As String
    FolderPath = "c:\Users\Desktop\Tryout\"

    ' Set Folder FSO
    Dim Folder As Scripting.Folder
    Set Folder = FSO.GetFolder(FolderPath)

    ' Loop thru each file
    Dim File As Scripting.File
    Dim a As Range, b As Range, c As Range, d As Range, e As Range, f As Range
    For Each File In Folder.Files

        Dim wkbData As Workbook
        Set wkbData = Workbooks.Open(File.Path)

        Dim wksData As Worksheet
        ActiveSheet.Name = "Control"
        Set wksData = wkbData.Worksheets("Control") ' -> Assume this file has only 1 worksheet

        'Format of the data
        Dim BlankRow As Long
        BlankRow = wks.Range("A" & wks.Rows.Count).End(xlUp).Row + 1

        ' Write filename in col E
        wks.Cells(BlankRow, 5).Value = File.Name
        wks.Cells(BlankRow, 6).Value = File.Name
        wks.Cells(BlankRow, 7).Value = File.Name

                        'Find TestProg
        Set a = wksData.Columns("A:A").Find("  testprog         : ", LookIn:=xlValues)
        If Not a Is Nothing Then
        wks.Cells(BlankRow, 1).Value = a.Value
        End If

        'Find StartTime
        Set b = wksData.Columns("A:A").Find("  Started at: ", LookIn:=xlValues)
        If Not b Is Nothing Then
        wks.Cells(BlankRow, 2).Value = b.Value
        End If

                'Find Temp
        Set c = wksData.Columns("A:A").Find("  temperat         : ", LookIn:=xlValues)
        If Not c Is Nothing Then
        wks.Cells(BlankRow, 3).Value = c.Value
        End If

                        'Find Type
        Set d = wksData.Columns("A:A").Find("  testings         : ", LookIn:=xlValues)
        If Not d Is Nothing Then
        wks.Cells(BlankRow, 4).Value = d.Value
        End If

        'Find Version
        Set e = wksData.Columns("A:A").Find("SmartABC ", LookIn:=xlValues)
        If Not e Is Nothing Then
        wks.Cells(BlankRow, 9).Value = e.Value
        End If

        Set f = wksData.Columns("A:A").Find("ERROR: ", LookIn:=xlValues)
        If Not f Is Nothing Then
        wks.Cells(BlankRow, 10).Value = f.Value
        wks.Cells(BlankRow, 11).Value = f.Address
        End If

但是，如下面的代码所示，它会查找字符串，然后将其复制到工作表中，但是我想将它们组合在一起成为一个代码

例如，如果找到“ testprog”，则将其复制到A行，但如果找不到testprog，我将复制“ start time”而不是行A，这意味着“ testprog”和“ start time”都存在于Row中答：

我想结合下面的2个代码，以便如果找到“ testprog”，则将其添加到A行中，然后，如果某些文件中不包含“ testprog”，请在下一个位置找到“ StartTime”，并在其中填入空白A行，因此完全不会有空格，它将被“ testprog”或“ StartTime”占用很抱歉长发

'Find Testprog
        Set a = wksData.Columns("A:A").Find("  testprog         : ", LookIn:=xlValues)
        If Not a Is Nothing Then
        wks.Cells(BlankRow, 1).Value = a.Value
        End If

                        'Find StartTime
        Set p = wksData.Columns("A:A").Find("  Started at: ", LookIn:=xlValues)
        If Not p Is Nothing Then
        wks.Cells(BlankRow, 1).Value = p.Value
        End If

之前

之后

一起查找2个或更多字符串

0 个答案: