對於每個循環，Excel VBA

Question

我有一個Excel文件，該文件是PDF到Excel轉換的結果。 excel文件中的數據對於某些列不是很干凈。

需要完成的工作：

我創建了一個For Each循環，以遍歷“ B”列並找到拍賣編號。 一旦找到，就會創建第二個For Each循環，以遍歷“ E”列，找到第一個出現的地址，並剪切此單元格並將其移至拍賣編號的同一行。

問題：

每個循環的第二個始終從“ E”列的頂部開始，而不是從“ B”列中的每個循環行號的結尾處開始。

該代碼已完成約85％，運行時沒有錯誤

    Sub Macro1()

    Dim rCell As Range
    Dim rCell2 As Range


    Dim rCell3 As Range

    Dim rRng As Range
    Dim rRng2 As Range
    Dim rRng3 As Range

    Dim i As Integer
    Dim j As Integer

    Dim strMyValue As String

    Set rRng = Sheet2.Range("B:B")
    Set rRng2 = Sheet2.Range("E:E")
    Set rRng3 = Sheet2.Range("F:F")

    i = 0
    j = 0

    For Each rCol In rRng.Columns

        For Each rCell In rCol.Rows

            If InStr(rCell.Value, "FEB") > 1 Then

              i = rCell.Row

        Debug.Print rCell.Address, rCell.Value, rCell.Row, i


                 For Each rCol2 In rRng2.Columns
                       For Each rCell2 In rCol2.Rows


             If InStr(rCell2.Value, ", PA 1") > 1 Then

                      If InStr(Cells(rCell2.Row + 1, "E"), ", PA 1") = 0 Then
                              Debug.Print Cells(rCell2.Row + 1,"E").Value
                      Else
                           Cells(rCell2.Row + 1, "E").Clear

                     End If


                     rCell2.Cut Cells(rCell.Row, "D")

                    Exit For

           End If

         Next rCell2

     Next rCol2

    End If


        Next rCell
    Next rCol


    End Sub

感謝任何幫助。 我只是解決不了..

Answer 1

你可以試試這個嗎？ 您的循環次數超出了您的需要，因為您的范圍只是單列。 也不需要遍歷所有百萬行，只需遍歷已使用的位。

Sub Macro1()

Dim rCell As Range
Dim rCell2 As Range
Dim rCell3 As Range

Dim rRng As Range
Dim rRng2 As Range
Dim rRng3 As Range
Dim rCol As Range
Dim rCol2 As Range

Dim i As Long
Dim j As Long

Dim strMyValue As String

With Sheet2
    Set rRng = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
    Set rRng3 = .Range("F1", .Range("F" & Rows.Count).End(xlUp))
End With

For Each rCell In rRng
    If InStr(rCell.Value, "FEB") > 1 Then
        i = rCell.Row
        Debug.Print rCell.Address, rCell.Value, rCell.Row, i
        With Sheet2
            Set rRng2 = .Range(.Cells(i, "E"), .Cells(.Rows.Count, "E").End(xlUp))
        End With
        For Each rCell2 In rRng2
            If InStr(rCell2.Value, ", PA 1") > 1 Then
                If InStr(rCell2.Offset(1), ", PA 1") = 0 Then
                    Debug.Print rCell2.Offset(1).Value
                Else
                    rCell2.Offset(1).Clear
                End If
                rCell2.Cut rCell2.Offset(,-1)
                Exit For
            End If
        Next rCell2
    End If
Next rCell

End Sub

Answer 2

屏幕截圖

謝謝SJR ..

我附上了工作簿的屏幕截圖。 到目前為止，您已經幫助我使循環適用於“ B”列中的每個拍賣編號，可以在“ E”列中找到地址並將其放在拍賣編號同一行的“ D”列中。

我現在面臨的問題是兩個。 1.拍賣有兩個地址 2.根本沒有地址。

我現在使用代碼的解決方案將執行以下操作：僅獲取第一個地址並正確放置它，而保留其他地址。 並且，如果它們的地址不是拍賣編號“ 003FEB18”的地址，則循環將拾取單元格E21“ 112 WASHINGTON PLACE UNIT 4A”，並將其錯誤地放置在拍賣編號“ 003FEB18”的D13單元格上

For Each rCell In rRng
    If InStr(rCell.Value, "FEB") > 1 Then
        i = rCell.Row
        'Debug.Print rCell.Address, rCell.Value, rCell.Row, i
        With Sheet2
            Set rRng2 = .Range(.Cells(i, "E"), .Cells(.Rows.count, 
    "E").End(xlUp))
            End With
                For Each rCell2 In rRng2
                If InStr(rCell2.Value, ", PA 1") > 1 Then

                rCell2.Cut Cells(rCell.Row, "D") 'rCell2.Offset(, -1)
                Exit For
            End If
        Next rCell2
    End If
Next rCell