Question

目标是指定两个不同的条件，每当满足其中任何一个条件时，将复制主文件（thisworkbook）中的整行，然后将其粘贴到新工作簿。

我认为这些问题与“if”函数有关，因为这段代码可以很好地处理一个条件（创建新工作簿并在条件满足时将所有行添加到此工作簿中）。

另一个问题：当masterfile包含许多符合指定条件的观察时，此方法非常耗时。出于这个原因，如果有人能够就此问题提出更好的解决方案，我将不胜感激。如果所有行都可以一次发布到正确的工作簿上，那么不会逐行粘贴行。

Private Sub CommandButton2_Click()
    a = Worksheets("Sheet1").Cells(Rows.Count, 9).End(xlUp).Row
    'creating new workbooks
    Dim newDataOne As Workbook
    Dim newDataTwo As Workbook
    Set newDataOne = Workbooks.Add
    Set newDataTwo = Workbooks.Add
    ThisWorkbook.Worksheets("Sheet1").Activate
    Dim nameone As String
    Dim nametwo As String
    nameone = ThisWorkbook.Worksheets("Sheet1").Range("CQ21")
    nametwo = ThisWorkbook.Worksheets("Sheet1").Range("CQ22")
    For i = 10 To a
        If Worksheets("Sheet1").Cells(i, 1).Value = nameone Then
            Worksheets("Sheet1").Rows(i).Copy
            newDataOne.ActiveSheet.Activate
            b = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            newDataOne.ActiveSheet.Cells(b + 1, 1).Select
            ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats
            ThisWorkbook.Worksheets("Sheet1").Activate
        End If
        If Worksheets("Sheet1").Cells(i, 1).Value = nametwo Then
            Worksheets("Sheet1").Rows(i).Copy
            newDataTwo.ActiveSheet.Activate
            h = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            newDataTwo.ActiveSheet.Cells(h + 1, 1).Select
            ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats
            ThisWorkbook.Worksheets("Sheet1").Activate
        End If
    Next i
End Sub

＆GT;

Answer 1

请改为尝试：

If Worksheets("Sheet1").Cells(i, 1).Value = nameone Or Worksheets("Sheet1").Cells(i, 1).Value = nametwo Then
            Worksheets("Sheet1").Rows(i).Copy
            newDataOne.ActiveSheet.Activate
            b = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            newDataOne.ActiveSheet.Cells(b + 1, 1).Select
            ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats
            ThisWorkbook.Worksheets("Sheet1").Activate
End If

您可以使用If Then指定两个Or语句来代替两个.Select语句。如果满足任一条件，则复制并粘贴该行。

关于运行代码所花费的时间，通常应该避免使用.Activate和[[UIBezierPath bezierPathWithRoundedRect:cell.profilePicImgView.bounds cornerRadius:60.0] addClip];，这些都是你做的很多。试着看看你是否能想出办法自己避免这种情况 - 如果你能在今天晚些时候帮助你的话。

Answer 2

我找不到关于第二个“if”的任何错误。我建议检查CQ22的值是否为错误，例如。

尽量避免激活和选择以缩短运行代码的时间。

Private Sub CommandButton2_Click()
    a = Worksheets("Sheet1").Cells(Rows.Count, 9).End(xlUp).Row
    'creating new workbooks
    Dim newDataOne As Workbook
    Dim newDataTwo As Workbook
    Set newDataOne = Workbooks.Add
    Set newDataTwo = Workbooks.Add
    Dim nameone As String
    Dim nametwo As String
    nameone = ThisWorkbook.Worksheets("Sheet1").Range("CQ21")
    nametwo = ThisWorkbook.Worksheets("Sheet1").Range("CQ22")
    For i = 10 To a
        If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value = nameone Then
            ThisWorkbook.Worksheets("Sheet1").Rows(i).Copy
            b = newDataOne.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            newDataOne.ActiveSheet.Cells(b + 1, 1).PasteSpecial xlPasteValuesAndNumberFormats
        End If
        If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value = nametwo Then
            ThisWorkbook.Worksheets("Sheet1").Rows(i).Copy
            h = newDataTwo.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            newDataTwo.ActiveSheet.Cells(h + 1, 1).PasteSpecial xlPasteValuesAndNumberFormats
        End If
    Next i
End Sub

当条件满足时，VBA将行复制并过去到不同的工作簿

2 个答案: