开发者

excel vba macro - extract value from where clause

In columnA of excel sheet 'Input' I have the following (with each line being on a new row in the sheet):

    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';

I'm trying to create a new sheet 'output' that only contains the following values in columnA but I don't know how to extract the bit in between the quotes after --> where my_key:

84
37

Some notes: it would be great to be able to sp开发者_JS百科ecify the fieldname in cell B1 of sheet 'input', in this example it would be my_key.

Previously, I've been doing this manually using filter column where text contains 'where' then stripping out everything after the equals then doing a find/replace on single quotes and ;s. Has anyone been able to achieve this with a single button click macro?


While using Filtering or Find is very efficient I don't think you will see much difference in using a variant array to hold the all values for your Input Sheet, to be tested against a regex using a fieldname in InputB1, with any numeric portions of the match being dumped to Column A Output.

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


A simple solution but definitely not a good one could be like this:

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
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜