vba - 尝试循环 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

我还在下面列出了我试图从“数据”表上检索的数据示例。 样本数据

谢谢大家的帮助！

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

它确实提出了另一个问题，我将在另一篇文章中解决。谢谢。