Excel VBAは、文字が見つかるまでループします。

Question

セルに文字列があります。「Client Ref：F123456PassPlus」と表示されます。 数字の前に文字列がない可能性があります。数値に記号があり、文字と数字の間にスペースがある可能性があります。 数値だけを変数として抽出する必要があります。私はそれを行うコードを持っていますが、文字列をループするのをいつ止めるかはわかりません。数字や記号以外のものがある場合には停止する必要がありますが、それは代わりに実行されます。定義はありませんが、任意の変数の文字が以前に定義されている

IsNumber = 1 
ref = "" 
If branch = "" Then 
    e = b 
Else 
    e = b + 1 
End If 
f = 1 
While IsNumber = 1 
    For intpos = 1 To 15 
     ref = Mid(x, e, f) 
     f = f + 1 
     Select Case Asc(ref) 
      Case 45 To 57 
       IsNumber = 1 
      Case Else 
       IsNumber = 0 
       Exit For 
     End Select 
    Next 
    IsNumber = 0 
Wend 

は、eはコピーを開始し、xが文字列を含むセルであるようにコードを伝えます。今のところ、すべてうまく動作し、数字で始まりコピーしてより大きな文字列にしますが、インポスが15に達すると停止します。

Answer 1

私は、ASCチェックを取り除くと、あなたが数値の「文字列」を構築する前にそれを渡すよう、各文字に対するチェックを追加しましました。

IsNumber = 1 
ref = "" 
If branch = "" Then 
    e = b 
Else 
    e = b + 1 
End If 
f = 1 
While IsNumber = 1 
    For intpos = 1 To 15 
     char = Mid(x, e + intpos, 1) 
     f = f + 1 
     If IsNumeric(char) Then 
      ref = Mid(x, e, f) 
      IsNumber = 1 
     Else 
      IsNumber = 0 
      Exit For 
     End If 
    Next 
    IsNumber = 0 
Wend 

Answer 2

このコードは、 「12345」を生成する）。大規模な文字列やより複雑な抽出が必要な場合は、正規表現COMオブジェクトについて学ぶことを検討します。

Function ExtractNumber(ByVal text As String) As String 

    ExtractNumber = "" 

    foundnumber = False 

    For e = 1 To Len(text) 
    ref = Mid(text, e, 1) 
     Select Case Asc(ref) 
      Case 45 To 57 'this includes - . and /, if you want only digits, should be 48 to 57 
       foundnumber = True 
       ExtractNumber = ExtractNumber & ref 
      Case Else 
       If foundnumber = True Then Exit For 
     End Select 
    Next 

End Function 

Answer 3

あり、あなたは、このタスクを達成しようとしてどのようには何の問題もありませんが、私はこの例

:-)正規表現を示唆してから自分自身を助けることができないA1に位置して文字列からすべての非数字を削除します結果をメッセージボックスに表示します。使用パターンは[^0-9]

Sub StripDigits() 
    Dim strPattern As String: strPattern = "[^0-9]" 
    Dim strReplace As String: strReplace = vbnullstring 
    Dim regEx As New RegExp 
    Dim strInput As String 
    Dim Myrange As Range 

    Set Myrange = ActiveSheet.Range("A1") 

    If strPattern <> "" Then 
     strInput = Myrange.Value 
     strReplace = "" 

     With regEx 
      .Global = True 
      .MultiLine = True 
      .IgnoreCase = False 
      .Pattern = strPattern 
     End With 

     If regEx.test(strInput) Then 
      MsgBox (regEx.Replace(strInput, strReplace)) 
     Else 
      MsgBox ("Not matched") 
     End If 
    End If 
End Sub 

であるあなたが範囲check out this postをループの例を含むExcelで正規表現を使用する方法の詳細については、「マイクロソフトのVBScriptの正規表現5.5」に

を参照を追加していることを確認します。

結果：