循環遍歷列並檢查單元格是否包含特定字符

Question

我需要幫助試圖判斷Instr函數是否會執行此操作。
在一個單元格中我有一些文本和數字（例如：Overlay 700 MHz - 06_469）
查看最終數字？ 2個數字後跟_（下劃線）或任何字母，然後是3個數字。

是否有任何方法在特定列中搜索此項，如果找到，只複製這些特定的組合？注意：它可以在單元格的任何位置，開始，結束，中間等.....

Answer 1

使用[正則表達式]查找'兩個數字 - 下劃線 - 三個數字'模式。

Option Explicit 

Sub pullSerialNumbers() 
    Dim n As Long, strs() As Variant, nums() As Variant 
    Dim rng As Range, ws As Worksheet 
    Dim rgx As Object, cmat As Object 

    Set rgx = CreateObject("VBScript.RegExp") 
    Set cmat = Nothing 
    Set ws = ThisWorkbook.Worksheets("Sheet1") 
    ReDim Preserve nums(0) 

    With ws 
     strs = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp)).Value2 
    End With 

    With rgx 
     .Global = True 
     .MultiLine = True 
     .Pattern = "[0-9]{2}\_[0-9]{3}" 
     For n = LBound(strs, 1) To UBound(strs, 1) 
      If .Test(strs(n, 1)) Then 
       Set cmat = .Execute(strs(n, 1)) 
       'resize the nums array to accept the matches 
       ReDim Preserve nums(UBound(nums) + 1) 
       'populate the nums array with the match 
       nums(UBound(nums) - 1) = cmat.Item(cmat.Count - 1) 
      End If 
     Next n 
     ReDim Preserve nums(UBound(nums) - 1) 
    End With 

    With ws 
     .Cells(2, "C").Resize(.Rows.Count - 1).Clear 
     .Cells(2, "C").Resize(UBound(nums) + 1, 1) = _ 
      Application.Transpose(nums) 
    End With 

End Sub 

這假定在任何一個單元中只能找到一個匹配。如果可能會有更多的循環通過匹配並添加每一個。

Answer 2

編輯 - 使用正則表達式進行通用匹配，解決問題以澄清問題。

使用正則表達式（RegExp）匹配模式「2位數，1位非數字，3位數」。您將需要添加Regex參考。在VBA編輯器，進入Tools>References和蜱

Microsoft VBScript Regular Expressions 5.5 

然後將下面的函數添加到模塊：

Function RegexMatch(Myrange As Range) As String 
    RegexMatch = "" 

    Dim strPattern As String: strPattern = "[0-9]{2}[a-zA-Z_\-]{1}[0-9]{3}" 
    Dim regEx As New RegExp 
    Dim strInput As String 
    strInput = Myrange.Value 

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

    If regEx.Test(strInput) Then 
     RegexMatch = regEx.Execute(strInput)(0) 
    End If 
End Function 

並使用它像這樣：

Dim myCell As Range 
Dim matchString As String 
For Each myCell In Intersect(ActiveSheet.Columns("A"), ActiveSheet.UsedRange) 
    matchString = RegexMatch(myCell) 
    ' Copy matched value to another column 
    myCell.Offset(0, 1).Value = matchString 
Next myCell 

結果：

更多關於VBA正則表達式，請參閱本SO問題：

How to use Regular Expressions (Regex) in Microsoft Excel both in-cell and loops

---

原始 - 搜索字符串匹配使用Instr。

說得沒錯，Instr函數就是你想要的，如果字符串不在字符串中則返回0，否則返回大於0的索引。

Dim myString as String 
myString = "Overlay 700 MHz - 06_469" 
Dim myDigitString as String 
' Use RIGHT to get the last 6 characters (your search string) 
myDigitString = Right(myString, 6) 

Dim myCell as Range 
' Cycle through cells in column A, which are also in the sheet's used range 
For each myCell in Intersect(ActiveSheet.Columns("A"), ActiveSheet.UsedRange) 

    If Instr(myCell.Value, myDigitString) > 0 Then 

     ' Copy cell to another sheet 
     myCell.copy Desination:=ActiveWorkbook.Sheets("PasteToThisSheet").Range("A1") 

     ' If you only want to get the first instance then... 
     Exit For 

    End If 

Next myCell 

匹配的模式 「2個位數，另一個字符，3位數字」 您可以使用：

For each myCell in Intersect(ActiveSheet.Columns("A"), ActiveSheet.UsedRange) 

    ' Check that first 2 digits and last 3 digits are in cell value 
    ' Also check that they are separated by 1 character 
    If Instr(myCell.Value, Left(myDigitString,2)) > 0 And _ 
     Instr(myCell.Value, Right(myDigitString,3)) > 0 And 
     Instr(myCell.Value, Right(myDigitString,3)) - Instr(myCell.Value, Left(myDigitString,2)) = 3 Then 

     ' Copy cell to another sheet 
     myCell.copy Desination:=ActiveWorkbook.Sheets("PasteToThisSheet").Range("A1") 

     ' If you only want to get the first instance then... 
     Exit For 

    End If 

Next myCell 

Answer 3

隨着數據列d：

Sub marine() 
    Dim r As Range 

    For Each r In Intersect(Range("D:D"), ActiveSheet.UsedRange) 
     s = r.Value 
     If s <> "" And InStr(s, "_") <> 0 Then 
      ary = Split(s, "_") 
      r.Offset(0, 1).Value = Right(ary(0), 2) & "_" & Left(ary(1), 3) 
      End If 
    Next r 
End Sub 

有幾種這種方法的問題：

• 文本開頭或結尾的下劃線
• 字符串中的多個下劃線
• 用字母包圍的下劃線。