макрос Excel vba - извлекает значение из предложения where

Question

В столбце A листа Excel «Ввод» у меня есть следующее (каждая строка находится в новой строке на листе):

    update my_table
    set time = sysdate,
    randfield1 = 'FAKE',
    randfield5 = 'ME',
    the_field8 = 'test'
    where my_key = '84'
    ;
    update my_table
    set time4 = sysdate,
    randfield7 = 'FAeKE',
    randfield3 = 'MyE',
    the_field9 = 'test'
    where my_key = '37';

Я пытаюсь создать новый «выход» листакоторый содержит только следующие значения в столбце A, но я не знаю, как извлечь бит между кавычками после -> где my_key:

84
37

Некоторые примечания: было бы здорово иметь возможностьукажите имя поля в ячейке B1 листа 'input', в этом примере это будет my_key.

Раньше я делал это вручную, используя столбец фильтра, где текст содержит «где», затем удаляя все послеравняется затем делать поиск / замену в одинарных кавычках и; s.Кто-нибудь смог достичь этого с помощью макроса клика одной кнопкой?

Answer 1

Простое решение, но определенно не очень хорошее, может быть таким:

Sub getWhere()

    Dim sRow as Integer
    Dim oRow as Integer
    Dim curSheet as Worksheet
    Dim oSheet as Worksheet

    dim words() as String

    Set curSheet = ThisWorkbook.Sheets("Input")
    Set oSheet = ThisWorkbook.Sheets("Output")


    sRow = 1
    oRow = 1
    Do while curSheet.Range("A" & sRow).Value <> ""
       If Instr(lcase(curSheet.Range("A" & sRow).Value), "where") > 0 Then
             words = Split(curSheet.Range("A" & sRow).Value, " ")
             oSheet.Range("B" & oRow).Value = words(1)
             oSheet.Range("C" & oRow).Value = getNumeric(words(3))
             oRow = oRow + 1
       End If

       sRow = sRow +1
    Loop
End Sub

    Function getNumeric(ByVal num As String) As Long
       Dim i As Integer
       Dim res As String

       For i = 1 To Len(num)
          If Asc(Mid(num, i, 1)) >= 48 And Asc(Mid(num, i, 1)) <= 57 Then res = res & Mid(num, i, 1)
       Next
       getNumeric = CLng(res)

    End Function

Answer 2

Хотя фильтрация или поиск очень эффективны, я не думаю, что вы увидите большую разницу в использовании массива вариантов для хранения всех значений для вашего входного листа, который будет проверен на соответствие регулярному выражению с использованием имени поля в InputB1, с любымчисловые части совпадения, выгружаемые в выходные данные столбца A.

Sub VarExample()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim X
Dim Y
Dim lngRow As Long
Dim objRegex
Dim objRegexMC
Set ws1 = ActiveWorkbook.Sheets("Input")
Set ws2 = ActiveWorkbook.Sheets("Output")
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = ".+where.+" & ws1.[b1] & ".+\'(\d+)\'.*"
 X = ws1.Range(ws1.[a1], ws1.Cells(Rows.Count, "A").End(xlUp)).Value2
ReDim Y(1 To UBound(X, 1), 1 To UBound(X, 2))
For lngRow = 1 To UBound(X, 1)
    If objRegex.test(X(lngRow, 1)) Then
    Set objRegexMC = objRegex.Execute(X(lngRow, 1))
        lngCnt = lngCnt + 1
       Y(lngCnt, 1) = objRegexMC(0).submatches(0)
    End If
Next
ws2.Columns("A").ClearContents
ws2.[a1].Resize(UBound(Y, 1), 1).Value2 = Y
End Sub