如何遍历字母和数字序列 (I30112-J01111)

Question

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

示例字符串：'I30112' I 代表 9 月（字母表中的第 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("Month") 那么它总是从 Month 中获取 M 而不是将其视为变量。

Answer 1

虽然您的问题没有说明一旦找到值后如何处理这些值，则将适当编码字符串的过滤集合收集到变体数组中，然后将它们推入 AutoFilter Method 的标准中似乎最方便的过程。

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

当您从一个月或一年的最后一天开始时，要获得第二天的时间会有些麻烦。由于未指定年份，因此使用当前年份来确定 2 月 29 日是否是一个因素。

还有一些事情需要处理。

1. 将编码的字符串放入例程。目前分配给enc = "I30112"。
2. 没有提及您在检索过滤集后实际想要对它执行的操作。我留下了一个评论区，过滤集在With ... End With statement 内。紧随其后，有一个删除过滤器的注释代码行。数据 ► 排序和过滤 ► 清除也会做同样的事情。

你的叙述提到了'通常是 156'。下面找到任何给定编码月份和日期的最大 'unit' 代码。

=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 列中的单位字符串
• 公式R1C1在B列中的等效数字
  =(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 月底测试转入明年的单位数量，因此您应该注意一些事项。

示例结果：