Question

我需要通过搜索字符串找到多行（通常是156）。

示例字符串：＆＃39; I30112＆＃39;我代表九月（字母表中的第9个字母），30代表9月的第30天，112代表9月30日的第112个单元。

我的用户打算说请从I30112开始查找下一个x单位。这意味着我将搜索I30112，I30113等，直到我到达I30156。 I30156之后的单位是J01001。所以我需要找到从I30112到J01111。

如何从工作表底部进行搜索循环，找到每个单元的最后一个引用？如果它们全部按顺序我可以找到一个，并抓住下一个156，但不幸的是它们并不总是按照正确的顺序。

谢谢！

--- ---编辑

我试图使用ASC（）方法。但是，鉴于我的用户输入是一个变量，我很难得到正确的字符。目前我有：

Dim Month As String  
Dim MonthChar As Integer  

Month = Left(UserForm1.TextBox1.Value, 1)  
MonthChar = Asc(Month)

然而，尽管Month是一个字符串，但我收到错误。如果我切换到Monthchar = Asc（＆＃34; Month＆＃34;）那么它总是从Month抓取M而不是将其视为变量。

Answer 1

虽然您的问题没有说明在您找到它们后如何处理这些值，但是将过滤后的适当编码字符串集合收集到变量数组中，然后将它们推入{{{{ 3}}似乎是最方便的过程。

Sub filter_for_encode_string()
    Dim str As String, enc As String, rw As Long
    Dim dt As Date, num As Long, dy As Long, ndy As Long, mn As String, nmn As String
    Dim v As Long, vFLTRs As Variant

    enc = "I30112"
    dt = DateSerial(Year(Date), Asc(Left(enc, 1)) - 64, Mid(enc, 2, 2))
    mn = Chr(Month(dt) + 64)
    dy = Day(dt)
    num = Val(Right(enc, 3))
    ndy = Day(dt + 1)
    nmn = Chr(Month(dt + 1) + 64)

    With Worksheets("Sheet4")
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            ReDim vFLTRs(0)
            For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
                str = .Cells(rw, 1).Value2
                If (Left(str, 1) = mn And Val(Mid(str, 2, 2)) = dy And Val(Right(str, 3)) >= num) Or _
                   (Left(str, 1) = nmn And Val(Mid(str, 2, 2)) = ndy And Val(Right(str, 3)) < num) Then
                    vFLTRs(UBound(vFLTRs)) = .Cells(rw, 1).Value2
                    ReDim Preserve vFLTRs(UBound(vFLTRs) + 1)
                End If
            Next rw
            If UBound(vFLTRs) Then ReDim Preserve vFLTRs(UBound(vFLTRs) - 1)

            .Columns(1).AutoFilter Field:=1, Criteria1:=(vFLTRs), _
                                   Operator:=xlFilterValues, VisibleDropDown:=False       
            With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    'do something with the filtered range
                End If
            End With
            '.Columns(1).AutoFilter Field:=1
        End With
    End With
End Sub

当你在一个月或一年的最后一天开始时，第二天就会有一点杂耍。由于未指定年份，因此使用当前年份来确定29-Feb是否是一个因素。

还有一些事情要处理。

将编码的字符串放入例程中。目前，这已分配enc = "I30112"。
在您检索过滤集后，没有提及您实际想要对过滤集进行的操作。我已离开评论区域，其中已过滤的集合位于AutoFilter Method之内。在此之后，有一个注释代码行删除过滤器。数据►分类＆amp;过滤器►Clear将执行相同的操作。

你的叙述提到＆＃39;通常是156＆＃39; 。以下内容查找了任何给定编码月份和日期的最大＆＃39;单位＆＃39; 代码。

=AGGREGATE(14, 6, RIGHT(A2:INDEX(A:A, MATCH("zzz",A:A )), 3)/(LEFT(A2:INDEX(A:A, MATCH("zzz",A:A )), 3)="I30"), 1)

Answer 2

有两种选择：

<强> 1。带数组的标准循环

Option Explicit

Public Sub findUnitsArray()
    Const COL           As Long = 1      'A
    Const START_UNIT    As Long = 112
    Const CRIT          As String = "I30"

    Dim ws As Worksheet, ur As Range, v As Variant, i As Long
    Dim totalFound As Long, msg As String

    Set ws = ActiveSheet
    Set ur = ws.UsedRange
    v = ur.Columns(COL)

    For i = 1 To ur.Rows.Count
        If InStr(v(i, 1), CRIT) > 0 Then
            If Val(Right(v(i, 1), 3)) >= START_UNIT Then         'compare last 3 characters
                totalFound = totalFound + 1
                msg = msg & v(i, 1) & ", "
            End If
        End If
    Next
    MsgBox "Found " & totalFound & " units:" & vbCrLf & vbCrLf & Left(msg, Len(msg) - 2)
End Sub

<强> 2。自动筛选和可见区域

Public Sub findUnitsAutoFilter()
    Const COL           As Long = 1     'A
    Const START_UNIT    As Long = 112
    Const CRIT          As String = "=I30**"

    Dim ws As Worksheet, ur As Range, ar As Range, cel As Range
    Dim totalFound As Long, msg As String

    Set ws = ActiveSheet
    Set ur = ws.UsedRange

    ws.AutoFilterMode = False
    With ur
        .AutoFilter
        .AutoFilter Field:=COL, Criteria1:=CRIT, Operator:=xlAnd
        For Each ar In .Columns(COL).SpecialCells(xlCellTypeVisible).Areas
            For Each cel In ar
                If Val(Right(cel.Value2, 3)) >= START_UNIT Then  'compare last 3 characters
                    totalFound = totalFound + 1
                    msg = msg & cel.Value2 & ", "
                End If
            Next
        Next
    End With
    MsgBox "Found " & totalFound & " units:" & vbCrLf & vbCrLf & Left(msg, Len(msg) - 2)
End Sub

Answer 3

我在工作表上有交互代码。

考虑以下工作表（Sheet4）：

A列中的单位字符串
B列中的等效数字由FormulaR1C1为=(CODE(RC[-1])-CODE("A")+1)*100000+VALUE(RIGHT(RC[-1],LEN(RC[-1])-1))
动态命名范围 MDU_String ：
=OFFSET(Sheet4!$A$1,1,0,COUNTA(Sheet4!$A:$A)-1,1)
2个静态命名范围：
Lookup_from ：=Sheet4!$E$1
For_units ：=Sheet4!$G$1
E1的数据验证：

现在在Sheet4的工作表模块中（已修复问题）：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target
        Case ThisWorkbook.Names("Lookup_from").RefersToRange, ThisWorkbook.Names("For_units").RefersToRange
            SetupFilter Target
    End Select
End Sub

Private Sub SetupFilter(ByVal Target As Range)
    Dim lUnits As Long, sLookup As String
    Dim oRng As Range, lFrom As Long, lTo As Long, lCount As Long, bStop As Boolean
    Dim lMonth As Integer, lDay As Integer, dNextDay As Date, iTry As Integer

    ResetFilter ' Remove AutoFilter
    Application.ScreenUpdating = False
    If Not IsEmpty(Target) Then
        sLookup = ThisWorkbook.Names("Lookup_from").RefersToRange.Value
        lUnits = ThisWorkbook.Names("For_units").RefersToRange.Value
        Debug.Print "Lookup " & lUnits & " from " & sLookup
        Set oRng = ThisWorkbook.Names("MDU_String").RefersToRange.Find(sLookup)
        If Not oRng Is Nothing Then
            lFrom = oRng.Offset(0, 1).Value ' Number equivalent
            lTo = lFrom
            lCount = 0
            iTry = 0
            dNextDay = Date
            bStop = False
            ' Start from the Lookup_for, locate the last unit to show
            Do
                Debug.Print "Looking for lTo: " & lTo & " (" & lCount & ")"
                Set oRng = ThisWorkbook.Names("MDU_String").RefersToRange.Offset(0, 1).Find(What:=CStr(lTo), LookIn:=xlValues, LookAt:=xlWhole)
                If oRng Is Nothing Then
                    lMonth = lTo \ 100000
                    lDay = lTo \ 1000 Mod 100
                    dNextDay = DateSerial(Year(Date), lMonth, lDay + 1) ' Move to next day
                    If Year(Date) = Year(dNextDay) Then
                        lMonth = Month(dNextDay)
                        lDay = Day(dNextDay)
                        lTo = lMonth * 100000 + lDay * 1000 + 1 ' Try 001 on next day
                        Debug.Print "Try next day lTo: " & lTo
                    Else
                        bStop = True
                    End If
                    iTry = iTry + 1
                    If iTry > 2 Then bStop = True
                Else
                    lTo = lTo + 1 ' Try next incremented unit
                    iTry = 0 ' Reset trying counter
                    lCount = lCount + 1
                End If
                bStop = (lCount >= lUnits) Or bStop
            Loop Until bStop
            Debug.Print "lFrom: " & lFrom & vbTab & "lTo: " & lTo
            ' Activate the filter
            Union(Range("MDU_String"), Range("MDU_String").Offset(0, 1)).AutoFilter Field:=2, Criteria1:=">=" & lFrom, Operator:=xlAnd, Criteria2:="<" & lTo
            Set oRng = Nothing
        End If
    End If
    Application.ScreenUpdating = True
End Sub

Private Sub ResetFilter()
    Union(Range("MDU_String"), Range("MDU_String").Offset(0, 1)).AutoFilter Field:=2
End Sub

这将允许您根据E1和G1的变化进行交互式自动筛选。它背后的数学可能会让人感到困惑，但无论是当天的翻滚天数还是当天的单位数量（最多999个单位），它都会使事情变得最通用。

对于明年推出的单位数量，我们不会在12月底进行测试，所以你应该注意这一点。

样本结果：

如何遍历字母和数字序列（I30112-J01111）

3 个答案: