Question

我有一个以下问题（并敦促克服它:)）。我需要让循环遍历行，直到找到某个值。让我在我的代码中更详细地演示我需要的内容：

For x = 1 To 1000
    If Cells(x, "O").Value = "P" Or Cells(x, "O").Value = "R" Then

        Dim i As Integer
        For i = 1 To 121
            If Worksheets(Cells(x, "P").Value).Cells(Cells(x, "Q").Value + i, "C") = "" Then
                With Worksheets(Cells(x, "P").Value)
                    .Cells(Cells(x, "Q").Value + i, "A").Resize(, 20).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    Range("F" & x, "H" & x).Copy
                    .Cells(Cells(x, "Q").Value + i, "E").PasteSpecial xlPasteAll
                    .Cells(Cells(x, "Q").Value + i, "C") = "Pur"
                    Range("AI" & x).Copy
                    .Cells(Cells(x, "Q").Value + i, "O").PasteSpecial xlPasteAll
                End With
            End If
        Next i

    End If

此代码只是遍历行，当指定的单元格（在本例中为“C”列中的单元格）为空时，它会执行所有复制和粘贴。但！它的表现时间与我所说的一样多（对于i = 1到121）。我需要的是一个循环，它将循环遍历行，直到出现“D”列中的第一个空单元格，然后执行所有复制和粘贴然后停止。我能做些什么才能实现这一目标？

如果我的问题含糊不清或难以理解，请告诉我。

正如mehow建议我更新我的问题并介绍我的尝试：
更改标有注释

Dim a As Integer 'I introduced new variable
a = 121          'This is it

For x = 1 To 1000
If Cells(x, "O").Value = "P" Or Cells(x, "O").Value = "R" Then

    Dim i As Integer
    For i = 1 To a 'Changes
        If Worksheets(Cells(x, "P").Value).Cells(Cells(x, "Q").Value + i, "C") = "" Then
            With Worksheets(Cells(x, "P").Value)
                .Cells(Cells(x, "Q").Value + i, "A").Resize(, 20).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("F" & x, "H" & x).Copy
                .Cells(Cells(x, "Q").Value + i, "E").PasteSpecial xlPasteAll
                .Cells(Cells(x, "Q").Value + i, "C") = "Pur"
                Range("AI" & x).Copy
                .Cells(Cells(x, "Q").Value + i, "O").PasteSpecial xlPasteAll
            End With
        a = i ' This way I wanted to end the loop sooner
        End If
    Next i

End If

Answer 1

在内部Exit For的末尾添加If，这样当您执行复制时，您可以离开它并进入下一行。

Answer 2

我认为这正是您所寻找的，代码为了清晰起见而评论：

Sub tgr()

    'Declare variables
    Dim wsData As Worksheet     'Sheet where the data is stored
    Dim wsDest As Worksheet     'Sheet that appropriate data will be copied to
    Dim rngFound As Range       'Range variable used to loop through column O on wsData
    Dim varSheetName As Variant 'Variable used to loop through the sheet names that we will be looking for with rngFound
    Dim strFirst As String      'Used to record the first found cell in order to avoid an infinite loop
    Dim lRow As Long            'Used to determine the row that found data will be pasted to in wsDest

    'Assign wsData to the sheet containing the data
    Set wsData = Sheets("Sheet1")

    'Start the loop by going through each value you are looking for
    'Based on your post, you are looking for "P" and "R"
    For Each varSheetName In Array("P", "R")

        'The values we are looking for are also sheetnames
        'Assign wsDest to the value
        Set wsDest = Sheets(varSheetName)

        'In wsData, look for the value within column "O", must be an exact, case-sensitive match
        Set rngFound = wsData.Columns("O").Find(varSheetName, wsData.Cells(Rows.Count, "O"), xlValues, xlWhole, MatchCase:=True)
        If Not rngFound Is Nothing Then

            'Found a match, record the first match's cell address
            strFirst = rngFound.Address

            'Start a new loop to find every match
            Do

                'Determine the next empty row based on column C within wsDest
                lRow = wsDest.Cells(Rows.Count, "C").End(xlUp).Row + 1

                'Column C at the new row should be set to "Pur"
                wsDest.Cells(lRow, "C").Value = "Pur"

                'Copy columns F:H within wsData and paste to column E within wsDest at the new row
                wsData.Range("F" & rngFound.Row & ":H" & rngFound.Row).Copy wsDest.Cells(lRow, "E")

                'Copy column AI within wsData and paste to column O within wsDest at the new row
                wsData.Cells(rngFound.Row, "AI").Copy wsDest.Cells(lRow, "O")

                'Advance the loop to the next matching cell
                Set rngFound = wsData.Columns("O").Find(varSheetName, rngFound, xlValues, xlWhole, MatchCase:=True)

            'Exit the loop when we are back at the first matching cell
            Loop While rngFound.Address <> strFirst

        End If

    'Advance to the next value (which is a sheet name) that you will be looking for
    Next varSheetName

    'Object variable cleanup
    Set wsData = Nothing
    Set wsDest = Nothing
    Set rngFound = Nothing

End Sub

Answer 3

Artur，以下代码将循环复制值从A列到B，直到遇到空白单元格，值“R”，“P”或它到达第1000行。您应该能够为您修改它目的。

Sub Stack2()
Dim lRowCounter As Long

lRowCounter = 1

Do While lRowCounter < 1000 _
         And Cells(lRowCounter, "A").Value <> "P" _
         And Cells(lRowCounter, "A").Value <> "R" _
         And Cells(lRowCounter, "A").Value <> ""

    Cells(lRowCounter, "B").Value = Cells(lRowCounter, "A").Value


lRowCounter = lRowCounter + 1
Loop

End Sub

循环直到找到某个值

3 个答案: