尝试循环IF（工作表中的MID函数）>

Question

我有一个名为Data的工作表，可以从固定宽度.txt文件中复制和粘贴数据。我需要遍历每一行并从中提取数据，这大约需要100,000行以上的数据，如果符合条件，它将在名为AVS的工作表上显示结果。我确定我缺少一些简单的东西，但是对我而言，这只会给我第一行的结果，然后停止。

这是我到目前为止的内容：

Sub AVSRev()
    Dim ws As Worksheet, thisRng As Range, ws1 As Worksheet
    Dim lastrow As Long

    Set ws1 = ThisWorkbook.Sheets("Data")
    Set ws = ThisWorkbook.Sheets("AVS")
    Set thisRng = ws.Range("A1")

    Application.ScreenUpdating = False

    With ws
        lastrow = .Range("A" & .Rows.Count).End(xlUp).row

        If Mid(ws1.Range("A1:A" & lastrow).Value, 1, 3) = "AVS" Then
        thisRng = Mid(ws1.Range("A1:A" & lastrow).Text, 48, 4)

        End If

        On Error Resume Next
        Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Clear
        Application.ScreenUpdating = True
    End With
End Sub
经过几天的混乱之后，我将代码重写如下。我没有像以前那样遇到任何错误，但是它会永远持续下去，并且完成后没有列出任何数据。 

Option Explicit
Sub test123()

Dim ws As Worksheet
Dim ws1 As Worksheet

Set ws = ThisWorkbook.Worksheets("DATA")
Set ws1 = ThisWorkbook.Worksheets("AVS")
Dim lastRow, myLoop, newValue
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).row
Dim AVS As Range
Application.ScreenUpdating = False


Range("A" & lastRow).ClearContents

For myLoop = 1 To lastRow

On Error Resume Next
   AVS = MID(ws.Range("A1:A" & myloop).Value, 1, 3)
   If IsError(AVS.Value) Then
    If Err.Number <> 0 Then
            Err.Clear
            On Error GoTo 0
        End If


Else
   If AVS = "AVS" Then
      'If MID(ws.Range("A1:A" & lastRow).Value, 1, 3) = "AVS" Then
         newValue = MID(ws.Range("A" & myLoop).Value, 48, 4)

    End If
End If
        ws1.Range("A" & myLoop).Value = newValue

Next

 Application.ScreenUpdating = True
End Sub
我还在“数据”表上列出了我要从中检索的数据示例。Sample Data

谢谢您的帮助！

我有一个名为数据的工作表，我从固定宽度的.txt文件中复制和粘贴数据。我需要遍历每一行并从中提取数据，如果匹配......>

Answer 1

感谢@ScottHoltman和@Gaffi，我设法使我的代码与以下内容一起循环：

Sub AVS()

Dim ws As Worksheet
Dim ws1 As Worksheet

Set ws = ThisWorkbook.Worksheets("DATA")
Set ws1 = ThisWorkbook.Worksheets("AVS")
Dim lastRow, myLoop, newValue
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).row
Application.ScreenUpdating = False


Range("A" & lastRow).ClearContents

For myLoop = 1 To lastRow

   If MID(ws.Range("A" & myLoop).Value, 1, 3) = "AVS" Then
      newValue = MID(ws.Range("A" & myLoop).Value, 48, 4)
End If

        ws1.Range("A" & myLoop).Value = newValue

Next

 Application.ScreenUpdating = True
End Sub