循环遍历列，并检查单元是否包含特定的字符
我需要帮助，试图判断Instr函数是否会执行此操作。
在一个单元格中，我有一些文本和数字（例如： Overlay 700 MHz - 06_469 ）
看最后的数字？ 2个数字后跟_ （下划线）或任何字母，然后是3个数字。
有什么方法在特定的列中search这个，如果find，只复制这些特定的组合？ 注：它可以在单元格的任何地方，在开始，结束，中间等…..
使用[正则expression式]查找“两个数字 – 下划线 – 三个数字”模式。
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
这假定在任何一个单元中只能find一个匹配。 如果可以有更多的循环通过比赛，并添加每一个。
编辑 – 使用正则expression式进行通用匹配，澄清问题的解决scheme。
使用正则expression式（RegExp）匹配“2位数，1位非数字，3位数”模式。 您将需要添加正则expression式参考。 在VBA编辑器中，转至Tools > References并勾选
Microsoft VBScript Regular Expressions 5.5
然后将以下function添加到您的模块：
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 RegExp的更多信息，请参阅此SO问题：
如何在Microsoft Excel中使用正则expression式（正则expression式）在单元格内和循环中
原始 – 使用Instr进行searchstring匹配。
你是对的， Instr函数是你想要的，如果string不在string中，则返回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
使用列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
这种方法有几个问题：
- 文本开头或结尾处的下划线
- string中有多个下划线
- 用字母包围的下划线。