Question

我需要帮助，试图确定Instr功能是否可以做到这一点在单元格中，我有一些文字和数字（例如：echo 4）
看到最终的数字？ 2个数字后跟 _ （下划线）或任何字母，然后再增加3个数字。

有没有办法在特定列中搜索此内容，如果找到，只复制这些特定组合？注意：它可以在单元格的任何地方，开头，结尾，中间等.......

Answer 1

列 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

这种方法存在几个问题：

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

Answer 2

使用[正则表达式]查找＆＃39;两个数字 - 下划线 - 三个数字＆＃39;图案。

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

这假设在任何一个单元格中只能找到一个匹配项。如果可能有更多，那么循环匹配并添加每个。

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

2 个答案: