Question

我正在使用以下代码删除无效的文本实例，在本例中以冒号开头的语句。我知道我需要采取的所有步骤，但在自动过滤后我遇到了问题。我尝试使用

遍历可见单元格

for x=1 to currentFilter.rows.count

和

for each x in currentFilter.rows

但无论我怎么尝试，我都会在尝试通过使用（基本要点）摆脱第一个字符（冒号）时遇到某种错误：

Cell Value = Right(Cell Value, Len(Cell Value) - InStr(Cell Value, ",", vbTextCompare))

我的完整代码如下：

Sub PRTCheck()
    'Column AN is Production Time & Column AP is Rush Time
    Dim endRange As Integer, ShipandRush As Range, CommaColons As Collection, cell, i

    endRange = ActiveSheet.Cells(Rows.count, "AN").End(xlUp).Row
    Set ShipandRush = Union(ActiveSheet.Range("AN2:AN" & endRange), ActiveSheet.Range("AP2:AP" & endRange))

    ShipandRush.NumberFormat = "@"
    Set CommaColons = FindAllMatches(ShipandRush, ",:")
    If Not CommaColons Is Nothing Then
        Dim times() As String
        For Each cell In CommaColons
            times = Split(cell.Value, ",")
            For i = LBound(times) To UBound(times)
                If InStr(times(i), ":") = 1 Then times(i) = ""
            Next
            cell.Value = Join(times, ",")
            Do While InStr(cell.Value, ",,") <> 0
                cell.Value = Replace(cell.Value, ",,", ",", vbTextCompare)
            Loop
            If InStr(cell.Value, ",") = 1 Then
                cell.Value = Right(cell.Value, Len(cell.Value) - 1)
            End If
            If InStr(Len(cell.Value), cell.Value, ",") = Len(cell.Value) Then
                cell.Value = Left(cell.Value, Len(cell.Value) - 1)
            End If
        Next cell
    End If

    Set ShipandRush = ActiveSheet.Range("AN1:AN" & endRange)
    Dim currentFilter As Range, r
    ShipandRush.AutoFilter Field:=1, Criteria1:=":*" 'Starts with colon
    Set currentFilter = ShipandRush.Offset(1).SpecialCells(xlCellTypeVisible)
    If currentFilter.Rows.count > 0 Then
        For r = 1 To currentFilter.Rows.count
        '-------Error occurs on the next line-------
            currentFilter.Cells(r).Value = Right(currentFilter.Cells(r).Value, Len(currentFilter.Cells(r).Value) - InStr(currentFilter.Cells(r).Value, ",", vbTextCompare))
        Next
    End If
    ActiveSheet.AutoFilterMode = False
    End Sub

'Custom find and replace that circumvents 255 character find limitation
Function FindAllMatches(rng As Range, txt As String) As Collection
    Dim rv As New Collection, f As Range, addr As String, txtSrch As String
    Dim IsLong As Boolean

    IsLong = Len(txt) > 250
    txtSrch = IIf(IsLong, Left(txt, 250), txt)

    Set f = rng.Find(what:=txtSrch, lookat:=xlPart, LookIn:=xlValues, MatchCase:=False)
    Do While Not f Is Nothing
        If f.Address(False, False) = addr Then Exit Do
        If Len(addr) = 0 Then addr = f.Address(False, False)
    'check for the *full* value (case-insensitive)
        If InStr(1, f.Value, txt, vbTextCompare) > 0 Then rv.Add f
        Set f = rng.FindNext(After:=f)
    Loop
    Set FindAllMatches = rv
End Function

我的问题：

我做错了什么？如何迭代可见单元格中的每个值并成功执行上面提到的公式？

Answer 1

你真的只处理一个列，但我会尝试坚持使用循环遍历行的方法而不是在这种情况下基本相同的单元格（虽然Range.Rows不一样事情为Range.Cells）。

不连续的范围需要首先通过Range.Areas property，然后是每个区域内的Range.Rows属性进行循环。

dim a as long, r as long
with currentFilter
    If .Rows.count > 0 Then
        for a = 1 to .Areas.count
            For r = 1 To .Areas(a).Rows.count
                .Areas(a).Rows(r).Cells(1).Value = _
                   Right(.Areas(a).Rows(r).Cells(1).Value, _
                         Len(.Areas(a).Rows(r).Cells(1).Value) - _
                         InStr(1, .Areas(a).Rows(r).Cells(1).Value, ","))
            Next r
        Next a
    End If
end with

使用For Each ... Next可能更简单。

dim cfr as range
with currentFilter
    for each cfr in .Cells
        cfr = Right(cfr.Value, Len(cfr.Value) - InStr(1, cfr.Value, ","))
    Next cfr
end with

尝试使用vba

1 个答案: