テキストのより大きな抽出物からコードを抽出したいと思います。私が持っている定数は、コードが WP または MD で始まり、数値で終わることです。コードが含まれる可能性のあるパターンの例を以下に示します。
WP0053
WP053
WP_053
WP_0053
WP 053
WP 0053
MDC_308
WP6
WP6.1
MDC_0308
以下の期待される出力の画像を参照してください。
どんな助けでも大歓迎です
テキストのより大きな抽出物からコードを抽出したいと思います。私が持っている定数は、コードが WP または MD で始まり、数値で終わることです。コードが含まれる可能性のあるパターンの例を以下に示します。
WP0053
WP053
WP_053
WP_0053
WP 053
WP 0053
MDC_308
WP6
WP6.1
MDC_0308
以下の期待される出力の画像を参照してください。
どんな助けでも大歓迎です
これに沿って何かを試してください:-
Dim cell
Dim tmp as string
For each cell in activesheet.columns(1).usedrange.cells
If InStr(1, cell.Value, "_MDC_", vbTextCompare) > 0 Then
tmp = Right(cell.Value, Len(cell.Value) - InStr(1, cell.Value, "_MDC_", vbTextCompare))
tmp = Left(tmp, InStr(1, tmp, " ", vbTextCompare) - 1)
cell.offset(0,2).value = tmp
End If
next cell
Public Function GetCode(data As String) As String
startpos = InStr(data, "WP")
If startpos = 0 Then startpos = InStr(data, "MD")
fisrtNumPos = 0
For i = startpos To Len(data)
If fisrtNumPos = 0 And LastNumPos = 0 Then
If IsNumeric(Mid(data, i, 1)) Then
fisrtNumPos = i
End If
Else
If Not IsNumeric(Mid(data, i, 1)) Then
LastNumPos = i
Exit For
End If
End If
Next i
Endpos = LastNumPos - startpos
GetCode = Mid(data, startpos, Endpos)
終了機能
このコードを任意のモジュールに追加して試してください。
コードにスペースがない場合は、以下のコードが役立ちます。
サブテスト()
Data = "A850085_MDC-WP-01003_SRI Phase 2 - Programme Manager - Dionysios Psachoulias"
startpos = InStr(Data, "WP")
If startpos = 0 Then startpos = InStr(Data, "MD")
fisrtNumPos = 0
LastNumPos = 0
For i = startpos To Len(Data)
If fisrtNumPos = 0 And LastNumPos = 0 Then
If IsNumeric(Mid(Data, i, 1)) Then
fisrtNumPos = i
End If
Else
If Not IsNumeric(Mid(Data, i, 1)) Then
LastNumPos = i
Exit For
End If
End If
Next i
Endpos = LastNumPos - startpos
Debug.Print Mid(Data, startpos, Endpos)
サブ終了
これで動作するはずです。ただし、テキストに「MD」の後に「WP」が含まれている場合、WP からのみコードが取得されます。
例: data= "A850085_WPC-MD-01003_SRI Phase 2 - Program Manager - Dionysios Psachoulias"
結果は result= "WPC-MD-01003" になります