Question

我需要制作一个循环，我正在度过最艰难的时光。我想要完成的是循环A＆＃39; A列中的所有值。值从A5开始。然后，我希望它在＆＃39; Sheet1＆＃39;上查找相同的值。并检查第5列（E）的值。根据E（A，B，C）中的值，它执行3个任务之一。 C的任务是获取原始值，并在“ECData”中查找该值，并采取特定范围并将其粘贴到第4张“工作”中。实际发生了什么：它正在复制来自ECData＆＃39; ECData＆＃39;而不是找到特定的行并粘贴它的相应行。

我知道代码很混乱，我试图将其他代码中的点点滴滴混合在一起，完成我想要的东西。

有什么想法？ MS Office 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查找循环

1 个答案: