2011-09-22 122 views
0

在Excel工作表「輸入」的columnA我有以下的(每行中的片材是在一個新的行):Excel VBA中宏 - 從提取物值的where子句

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

我試圖創建一個新的工作表「輸出」只包含在columnA以下值,但我不知道如何提取位在引號之間後 - >其中my_key:

84 
37 

一些注意事項:這將是很高興能夠在工作表'input'的單元格B1中指定字段名,在本例中它將是my_key。

以前,我一直在使用過濾器列進行手動操作,其中文本包含'where',然後剝去equals之後的所有內容,然後在單引號和s上進行查找/替換。有沒有人能夠通過單擊按鈕來實現這一點?

回答

1

儘管使用Filtering或Find非常高效,但我不認爲在使用變量數組來保存輸入表的所有值方面,使用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 
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