循环不正确的Excel VBA答案

【问题标题】：Looping incorrectly Excel VBA循环不正确的Excel VBA
【发布时间】：2017-08-01 15:58:28
【问题描述】：

我正在尝试运行一个代码，该代码将搜索一列，查找关键字，然后将这些行复制并粘贴到另一个工作表中。不幸的是，当我逐步运行代码时，我可以看到它第一次尝试复制和粘贴一行时，它会复制活动单元格并将该值粘贴到下一张表中的行中，而忽略“如果Then”语句搜索关键字。粘贴活动单元格值后，它可以正常工作并粘贴正确的行，但我不知道为什么它首先粘贴活动单元格。

Sub CompletedJob()

'Looks through the status column (N) of the Projects Overview table and moves them to Completed table, then deletes row from projects list
Dim Firstrow As Long
Dim lastRow As Long
Dim LrowProjectsOverview As Long

With Sheets("Projects Overview")
    .Select

    Firstrow = .UsedRange.Cells(1).Row
    lastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
    For LrowProjectsOverview = lastRow To Firstrow Step -1
        With .Cells(LrowProjectsOverview, "N")
            If Not IsError(.Value) Then
                If ((.Value = "Complete - Design") Or (.Value = "P4P") Or (.Value = "Ready for Setup")) Then .EntireRow.Select

    Selection.Copy
                Range("A600:Q600").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False

                If Sheet9.Range("B2").Value = "" Then
                Sheet9.Range("A2:Q2").Value = Sheet1.Range("A600:Q600").Value
                Sheet1.Range("A600:Q600").ClearContents

                Else

                Sheet9.Range("B2").EntireRow.Insert
                Sheet9.Range("A2:Q2").Value = Sheet1.Range("A600:Q600").Value
                Sheet1.Range("A600:Q600").ClearContents
                Sheet9.Range("B2:Q2").Interior.Color = xlNone
                Sheet9.Range("B2:Q2").Font.Bold = False
                Sheet9.Range("B2:Q2").Font.Color = vbBlack
                Sheet9.Range("B2:Q2").RowHeight = 14.25

            End If

            If Sheet9.Range("B2").Value = "" Then
               Sheet9.Range("B2").EntireRow.Delete

            End If

    If ((.Value = "Complete - Design") Or (.Value = "P4P") Or (.Value = "Ready for Setup")) Then .EntireRow.Delete

            End If
        End With
    Next LrowProjectsOverview
End With

End Sub

【问题讨论】：

当你循环时你没有选择任何东西，因此你将复制当前的活动单元格。最好不要在代码中使用Selection。相反，您应该使用正在循环的变量。
当您的 If ((.Value = "Complete - Design") Or (... 评估为 False 时，您仍然复制当前选择的内容...
sheet1 和 sheet9 分别是哪些工作表？
不要使用 select ... selection ... ... EntireRow.Select ... Selection.Copy 应该是 ... EntireRow.Copy ..... Range("A600:Q600").select .... 应该是 Range("A600:Q600").PasteSpecial .... 顺便说一句工作表包含 Range("A600:Q600") ??
请参考我前几天在Alister M发帖nearly the same code时给我做的cmets。

标签： vba excel copy paste

【解决方案1】：

我试图重现您的问题。 我的代码不是您的直接解决方案。你需要让它适应你的问题。这很重要，因为这是您学习编码的方式。

我尽了最大努力尽可能多地注释我的代码。我没有引用工作表，请添加此内容，因为您试图从一张工作表复制到另一张工作表。

我不需要任何选择语句。

这是我的 vba 代码。

Option Explicit

Sub SearchKeyandCopy()
Dim LastLine As Long
Dim i As Long
Dim j As Long
'Find Number of Rows in Status column (column D)
LastLine = Columns("D").Find("*", , , , xlByColumns, xlPrevious).Row

'Set row where it should start pasting
j = 2

'Iterate over all cells with status
For i = 2 To LastLine
    'Check if the Keyword (Key) is in Status column
    'InStr returns the position and 0 if not found
    'code checks if position is different from 0
    If InStr(Cells(i, "D").Value, "key") <> 0 Then
        'Copy values
        Range(Cells(i, "A"), Cells(i, "D")).Copy Destination:=Range(Cells(j, "F"), Cells(j, "I"))
        'increase counter for where to paste
        j = j + 1
    End If
Next i

End Sub

这是运行代码之前的样子

这是运行代码后的样子

【讨论】：