VBA 查找循环

Question

我需要做一个循环，我正处于最艰难的时期。我想要完成的是遍历 'Assum' 的 A 列中的所有值。值从 A5 开始。然后我希望它在 'Sheet1' 上查找相同的值并检查第 5 列 (E) 的值。根据 E (A, B, C) 中的值，它执行 3 个任务之一。 C 的任务是获取原始值，并在 'ECData' 内查找该值，然后获取特定范围并将它们粘贴到第 4 个 sheet 'Work'。实际发生了什么：它是从 'ECData' 上不正确的行复制单元格，而不是找到特定的行并将其粘贴到相应的行。

我知道代码很乱，我正在尝试将其他代码的点点滴滴拼凑在一起，以完成我想要的。

有什么想法吗？微软办公室 2013

Public y1 As Integer

Sub ECLoop()


Dim i As Single
Dim finalRow As Long



finalRow = Sheets("Assum").Cells(Rows.Count, 1).End(xlUp).Row

For i = 5 To finalRow
        If Sheets("Sheet1").Cells(i, 5) = "A" Then
            Sheets("Assum").Cells(i, 2) = "Test A"
        ElseIf Sheets("Sheet1").Cells(i, 5) = "B" Then
            Sheets("Assum").Cells(i, 2) = "Test B"
        ElseIf Sheets("Sheet1").Cells(i, 5) = "C" Then
            Set FoundCell = ActiveCell
                If Not FoundCell Is Nothing Then
                y1 = FoundCell.Row
                End If
            Set NationalPaste = Sheets("Work").Range("Z3")
            Set OverPaste = Sheets("Work").Range("Z24")
            Set UnderPaste = Sheets("Work").Range("Z45")
            Set IFPPaste = Sheets("Work").Range("Z66")
            Set SeniorsPaste = Sheets("Work").Range("Z87")
             Sheets("ECData").Select
                With Sheets("ECData")
                    Set National = Range(Cells(y1, 2), Cells(y1, 21))
                    Set Over = Range(Cells(y1, 22), Cells(y1, 41))
                    Set Under = Range(Cells(y1, 42), Cells(y1, 61))
                    Set IFP = Range(Cells(y1, 62), Cells(y1, 81))
                    Set Seniors = Range(Cells(y1, 82), Cells(y1, 101))
                End With


            Sheets("Work").Range("Z3:Z22").ClearContents
            National.Copy
            NationalPaste.PasteSpecial Paste:=xlValues, Transpose:=True

            Sheets("Work").Range("Z24:Z43").ClearContents
            Over.Copy
            OverPaste.PasteSpecial Paste:=xlValues, Transpose:=True

            Sheets("Work").Range("Z45:Z64").ClearContents
            Under.Copy
            UnderPaste.PasteSpecial Paste:=xlValues, Transpose:=True

            Sheets("Work").Range("Z66:Z85").ClearContents
            IFP.Copy
            IFPPaste.PasteSpecial Paste:=xlValues, Transpose:=True

            Sheets("Work").Range("Z87:Z106").ClearContents
            Seniors.Copy
            SeniorsPaste.PasteSpecial Paste:=xlValues, Transpose:=True
        Else
            Exit Sub
        End If
Next i
End Sub

Answer 1

这可能无法完全回答您的问题，但评论时间太长了。如果您愿意回答我的问题（请参阅代码注释），我会对其进行更新以解决我认为是您的问题；但是，您或许可以使用以下信息自行完成此操作）。我也整理了一下你的代码

' Use Option Explicit to ensure all variables are declared - will save you a lot of debugging time
Option Explicit
Sub ECLoop()
    ' Make sure you declare all your variables
    ' Why is y1 public? Is it used elsewhere? Try to keep it local
    Dim i As Long, finalRow As Long, y1 As Long
    Dim NationalPaste As Range, OverPaste As Range, UnderPaste As Range, IFPPaste As Range, SeniorsPaste As Range
    Dim FoundCell As Range, National As Range, Over As Range, Under As Range, IFP As Range, Seniors As Range

    finalRow = Sheets("Assum").Cells(Rows.Count, 1).End(xlUp).Row

    With Sheets("Work")
        Set NationalPaste = .Range("Z3")
        Set OverPaste = .Range("Z24")
        Set UnderPaste = .Range("Z45")
        Set IFPPaste = .Range("Z66")
        Set SeniorsPaste = .Range("Z87")
    End With

    For i = 5 To finalRow
        If Sheets("Sheet1").Cells(i, 5) = "A" Then
            Sheets("Assum").Cells(i, 2) = "Test A"
        ElseIf Sheets("Sheet1").Cells(i, 5) = "B" Then
            Sheets("Assum").Cells(i, 2) = "Test B"
        ElseIf Sheets("Sheet1").Cells(i, 5) = "C" Then
            ' I think this is causing your error as it will always be the same
            ' Set this to what it should be e.g. Set FoundCell = Sheets("Assum").Cells(i,1)
            Set FoundCell = ActiveCell
            ' This If is fairly pointless as it will always be set. You also don't seem to resuse FoundCell
            ' So why not just set y1 straight away
            If Not FoundCell Is Nothing Then
                y1 = FoundCell.Row
            End If

            With Sheets("ECData")
                Set National = .Range(.Cells(y1, 2), .Cells(y1, 21))
                Set Over = .Range(.Cells(y1, 22), .Cells(y1, 41))
                Set Under = .Range(.Cells(y1, 42), .Cells(y1, 61))
                Set IFP = .Range(.Cells(y1, 62), .Cells(y1, 81))
                Set Seniors = .Range(.Cells(y1, 82), .Cells(y1, 101))
            End With

            With Sheets("Work")
                .Range("Z3:Z22").ClearContents
                National.Copy
                NationalPaste.PasteSpecial Paste:=xlValues, Transpose:=True

                .Range("Z24:Z43").ClearContents
                Over.Copy
                OverPaste.PasteSpecial Paste:=xlValues, Transpose:=True

                .Range("Z45:Z64").ClearContents
                Under.Copy
                UnderPaste.PasteSpecial Paste:=xlValues, Transpose:=True

                .Range("Z66:Z85").ClearContents
                IFP.Copy
                IFPPaste.PasteSpecial Paste:=xlValues, Transpose:=True

                .Range("Z87:Z106").ClearContents
                Seniors.Copy
                SeniorsPaste.PasteSpecial Paste:=xlValues, Transpose:=True
            End With
        Else
            ' Do you really want it to quit if the the cell doesn't equal your test conditions
            ' What about the rest of the cells?
            Exit Sub
        End If
    Next i
End Sub

VBA 查找循环

VBA Lookup Loop

excel

vba

ms-office