Question

我在使用vba复制特定行时遇到问题。

这是我的代码：

Dim color1 As Integer
Dim color2 As Integer
Dim lines As Integer

Workbooks.Open Filename:="D:\01 January.xlsm", _
    UpdateLinks:=0
 lines = WorksheetFunction.CountA(Range("U:U")) - 1


Dim i As Integer
For i = 6 To lines + 6

color1 = Cells(i, 21).Value
color2 = Cells(i, 22).Value

    If IsNumeric(Cells(i, 21)) Then

        Select Case color1 & color2
            Case Evaluate("=White") & Evaluate("=Blue")
                Rows(i & ":" & i).Select

            Case Evaluate("=Yellow") & Evaluate("=Yellow")
                Rows(i & ":" & i).Select

            Case Evaluate("=Yellow") & Evaluate("=Green")
                Rows(i & ":" & i).Select

        End Select

    End If
Next i

    Selection.Copy

    Windows("Test.xlsm").Activate

    Rows("11:11").Select

    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

End Sub

您可能会看到，我正在尝试选择符合January.xlsm标准的行，然后将它们粘贴到test.xlsm

目前它只粘贴最后选择的行，而不是所有行。

我对vba很新，所以我真的需要你的帮助。我在脑海中想到的是将所有需要的行放入一个数组中，然后将其复制到另一个工作簿中。但不知道那是好还是只是擦，如果这样可行，我就找不到解决方案......

感谢您的帮助！

Answer 1

它只粘贴最后一行的原因是因为你通过选择各行但不对它们做任何事情来循环。见修改后的代码。我已删除了case语句中的冗余选项，并提供了一个范围/联合组合来创建自定义范围，以确保您只粘贴到工作表一次。

Dim color1 As Integer
Dim color2 As Integer
Dim lines As Integer

Workbooks.Open Filename:="D:\01 January.xlsm", _
    UpdateLinks:=0
 lines = WorksheetFunction.CountA(Range("U:U")) - 1


Dim i As Integer
Dim rngUnion As Range
Dim booCopy As Boolean
For i = 6 To lines + 6
    booCopy = True
    color1 = Cells(i, 21).Value
    color2 = Cells(i, 22).Value

    If IsNumeric(Cells(i, 21)) Then

        Select Case color1 & color2
            Case Evaluate("=White") & Evaluate("=Blue")
            Case Evaluate("=Yellow") & Evaluate("=Yellow")
            Case Evaluate("=Yellow") & Evaluate("=Green")
            Case Else
                booCopy = False
        End Select

    End If
    If booCopy = True Then
        If rngUnion Is Nothing Then
            Set rngUnion = Rows(i & ":" & i)
        Else
            Set rngUnion = Union(rngUnion, Rows(i & ":" & i))
        End If
    End If

Next i
If Not rngUnion Is Nothing Then
    rngUnion.Copy
    Windows("Test.xlsm").Activate
    With Rows("11:11")
        .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        .PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    End With
    Application.CutCopyMode = False
End If
End Sub

Answer 2

这只粘贴最后一个选定行的原因是因为您没有在循环中复制和粘贴。如果在循环中移动Dim i As Integer For i = 6 To lines + 6 color1 = Cells(i, 21).Value color2 = Cells(i, 22).Value If IsNumeric(Cells(i, 21)) Then Select Case color1 & color2 Case Evaluate("=White") & Evaluate("=Blue"): Workbooks("Test").Sheets("Sheet1").Rows(i).Value = _ Workbooks("01 January").Sheets("Sheet1").Rows(i).Value ... End Select End If Next i，代码应该可以正常工作。更好的方法是避免完全复制和粘贴并直接设置行的值。请参阅以下代码：

public void OnPointerDown()
{  
    if (recordMode) {
        StartCoroutine(RecordCoroutine());
    } else {
        GetComponent<AudioSource>().Play();
    }
}

IEnumerator RecordCoroutine()
{
    //change the color to show that it's currently recording
    GetComponent<Image>().color = Color.red;

    //start recording
    GetComponent<AudioSource>().clip = Microphone.Start(null, false, 1, 44100);

    yield return new WaitForSeconds(1f);

    //stop the mic
    Microphone.End(null);

    //recover button color
    GetComponent<Image>().color = Color.white;
}

您可以根据需要更新工作表或工作簿名称，但此方法比复制和粘贴快得多。

Answer 3

如果您要复制大行数，并且粘贴它更安全，不要依赖Union()和Address()方法并切换到“帮助”列在哪里首先标记要复制的行，然后一次复制和粘贴。这也比上面的两个方法

快得多

您还可以利用SpecialCells()方法仅过滤“数字”单元格：

Dim lines As Long
Dim cell As Range

Workbooks.Open Filename:="D:\01 January.xlsm", UpdateLinks:=0
lines = WorksheetFunction.CountA(Range("U:U")) - 1
With Range(Cells(6, "U"), Cells(lines + 6, "U")) '<--| reference your relevant range in column "U"
    For Each cell In .SpecialCells(xlCellTypeConstants, xlNumbers) '<--| loop through "numeric" cells only
        Select Case cell.Value & cell.Offset(, 1).Value
            Case Evaluate("=White") & Evaluate("=Blue"), Evaluate("=Yellow") & Evaluate("=Yellow"), Evaluate("=Yellow") & Evaluate("=Green")
                cell.Offset(, 2).Value = 1 '<--| mark row for copying&pasting
        End Select
    Next
    With .Offset(, 2) '<-- consider column "W" cells corresponding to referenced cells
        If WorksheetFunction.CountA(.Cells) > 0 Then '<--| if there's at least one row marked for copy&paste
            .SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Copy '<--| copy all marked rows
            With Workbooks("Test.xlsm").ActiveSheet.Rows("11:11") '<--| reference target range
                .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                              SkipBlanks:=False, Transpose:=False
                .PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
                              SkipBlanks:=False, Transpose:=False
            End With
            Application.CutCopyMode = False '<--| clear clipboard
        End If
        .ClearContents '<--| clear "helper" column
    End With
End With

将特定行从一个工作簿复制到另一个工作簿

3 个答案: