Как написать программу для копирования определенных слов, а затем вставить эту строку и создать следующие 7 строк в Excel VBA

Question

Я не понимаю, как выполнить определенную задачу в Excel VBA.

На листе 1 в Excel есть 2 столбца и тысячи строк.Столбец 1 предназначен для времени, а столбец 2 - для операций.

Я хочу найти конкретные ключевые слова в предложении в столбце 2, например, (Test XS - end, result: PASSED) или (Test XS - end), result: failed), затем скопируйте строку со временем и предложением с ключевыми словами, а также копируйте следующие 6 строк каждый раз, когда появляются вышеуказанные ключевые слова в предложении.

Я хочу вставить их в лист 2.Таким образом, каждый раз, когда появляется ключевое слово, оно должно скопировать строку и следующие 6 строк и вставить в лист 2 и снова повторить его, как показано ниже.Я хочу сделать это для всех строк (> 500000 строк).

Не могли бы вы помочь мне сгенерировать код для выполнения этой задачи?

Answer 1

Попробуйте это

Option Explicit

Sub test()
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long
Dim j As Long
Dim k As Long
Dim KeyWord1 As String
Dim KeyWord2 As String

Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("sheet1")
Set ws2 = wb.Worksheets("sheet2")
k = 2
KeyWord1 = "Test XS - end, result: PASSED"
KeyWord2 = "Test XS - end, result: FAILED"

On Error Resume Next
For i = 2 To ws1.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    If Mid(ws1.Cells(i, 2).Value2, 1, 1) <> "#" Or Mid(ws1.Cells(i, 2).Value2, 1, 1) <> "=" Then
        If ws1.Cells(i, 2).Value2 = KeyWord1 Or ws1.Cells(i, 2).Value2 = KeyWord2 Then
            For j = 0 To 6
                ws2.Cells(k, 1).Value2 = FormatDateTime(ws1.Cells(i + j, 1).Value2, vbLongTime)
                ws2.Cells(k, 2).Value2 = ws1.Cells(i + j, 2).Value2
                k = k + 1
            Next
        End If
    End If
Next
End Sub

Как я уже пробовал в вашем примере, есть 2 небольших проблемы, которые не будут работать.Просто спросите своего менеджера / босса:

1- Ваш журнал представляет собой CSV на простом тексте.Слишком много ячеек со значениями, равными "========================== BUZZER (XS) - begin", которые при копировании Excel рассматривают как формулы, и вы получаете пустую ячейку.Попробуйте заменить «=» на «-» или любой другой разделитель, так как «=» создаст вам много проблем.Я пытался исправить с помощью MID(), LEFT(), RIGHT(), INSTR() и всех строковых функций, но они не работают.Я ввел символ «» для определения как текста, и он также не работает.Только что предложил вашему боссу заменить этого персонажа.

2- Этот макрос приносит время в vbLongTime, как, например, 23:59:59, но все же вам нужно до миллисекунд.Это зависит от вашей локальной настройки, поэтому просто добавьте формат после завершения макроса ... Это будет формат как "Selection.NumberFormat = "hh:mm:ss.000" или "Selection.NumberFormat = "hh:mm:ss,000"

Единственный вариант, который я нашел для исправления точки 1, это:

Option Explicit

Sub test()
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long
Dim j As Long
Dim k As Long
Dim KeyWord1 As String
Dim KeyWord2 As String

Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("sheet1")
Set ws2 = wb.Worksheets("sheet2")
k = 2
KeyWord1 = "Test XS - end, result: PASSED"
KeyWord2 = "Test XS - end, result: FAILED"

On Error Resume Next
For i = 2 To ws1.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    If Mid(ws1.Cells(i, 2).Value2, 1, 1) <> "#" Or Mid(ws1.Cells(i, 2).Value2, 1, 1) <> "=" Then
        If ws1.Cells(i, 2).Value2 = KeyWord1 Or ws1.Cells(i, 2).Value2 = KeyWord2 Then
            For j = 0 To 6
                ws2.Cells(k, 1).Value2 = FormatDateTime(ws1.Cells(i + j, 1).Value2, vbLongTime)
                If Mid(ws1.Cells(i + j, 2).Value2, 1, 1) = "=" Or Mid(ws1.Cells(i + j, 2).Value2, 1, 2) = "'=" Then
                    ws2.Cells(k, 2).Value2 = "'=========================" & Mid(ws1.Cells(i + j, 2).Value2, InStr(1, ws1.Cells(i + j, 2).Value2, " ", vbBinaryCompare), 500)
                Else
                    ws2.Cells(k, 2).Value2 = ws1.Cells(i + j, 2).Value2
                End If
                k = k + 1
            Next
        End If
    End If
Next
End Sub

Но я не могу проверить, есть ли точно 25 символов "=".

Надеюсь, это поможет