循环遍历列并检查单元格是否包含特定字符

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 

有几种这种方法的问题：

• 文本开头或结尾的下划线
• 字符串中的多个下划线
• 用字母包围的下划线。