[英]Excel VBA Extract Text from a Cell
我曾嘗試通過Stack Overflow尋找以前的建議,但沒有找到任何可行的方法。
這是我的情況:我正在嘗試查看一個簡單的Excel工作表,該工作表顯示某人的姓名,職位以及他們的“角色”,這是我正在創建的自定義字段。 現在,我希望只做“工程師”,但還將擴展到“管理助手”和“經理”之類的東西。 (真正的電子表格長約8100行)。
我所需要做的就是瀏覽“標題”列,查看它是否與字符串匹配(在這種情況下,我的測試字符串是工程師),然后復制字符串以及其余的I或II或III,或者在某些情況下,四之后。
我聽說過使用正則表達式,並且之前在SQL中使用過正則表達式,但是卻很難滿足我的需要。 這是我嘗試使用MID函數的當前代碼:
Sub GetRole()
' Custom function written to take role out of official title
strRole = "Engineer" ' String to check for
Dim lrow As Integer ' Number of Rows
Dim Role As String ' Role to write into adjacent cell
lrow = Cells(Rows.Count, "B").End(xlUp).Row
For i = lrow To 2 Step -1
If InStr(1, Cells(i, 2), "Engineer") > 0 Then
Role = Mid(Cells(i,3)), 1, 5)
Cells.(i, 3).Value = Role
End If
Next i
End Sub
但這並不太奏效。 任何幫助或建議,將不勝感激。 我願意提供任何必要的額外信息。
您可以使用正則表達式解決此問題。 首先,您需要轉到工具>引用...來啟用引用,然后啟用Microsoft VBScript Regular Expressions 5.5
然后使用以下代碼生成您的答案
Sub GetRole()
' Custom function written to take role out of official title
' Uncomment the below if using Early Binding i.e. you enable the reference
' Dim ReGex As New RegExp
' Comment below line if decide to use Late Binding (i.e. you enable the reference)
Dim ReGex As Object
Dim i As Long, lrow As Long ' Number of Rows
' Comment the below line if decide to use Late Binding (i.e. you enable the reference)
Set ReGex = CreateObject("VBScript.RegExp")
With ReGex
.Global = True
.IgnoreCase = True
.Pattern = "(Engineer\sI*\b)"
End With
With ActiveSheet
lrow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = lrow To 2 Step -1
If ReGex.test(.Cells(i, 2).Value2) Then .Cells(i, 3).Value2 = Trim(ReGex.Execute(Cells(i, 2).Value2)(0))
Next i
End With
End Sub
產生輸出:
我認為與調試VBA和Regex相比,Excel公式將更易於擴展:
=IF(ISNUMBER( FIND("Engineer III", E4)), "Engineer III",
IF(ISNUMBER( FIND("Engineer II" , E4)), "Engineer II",
IF(ISNUMBER(SEARCH("Engineer *I" , E4)), "Engineer I", "")))
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.