Question

我正在尝试复制符合特定条件的一些数据列，然后将复制数据的第一列粘贴到第二个电子表格的特定列中。我无法从复制的单元格中选择数据 - 第二个if语句。

新工作代码

Sub SortData()

'Clear Data from Practices Sheet
    Sheet2.Range("B6:F1000").Clear



a = Worksheets("Home").Cells(Rows.Count, 3).End(xlUp).Row

For i = 3 To a

    If Worksheets("Home").Cells(i, 4).Value = "Active" And Worksheets("Home").Cells(i, 3).Value = "Denmark" Then

    C = Worksheets("Home").Cells(i, 2).Copy

    Worksheets("Practices").Activate

    b = Worksheets("Practices").Cells(Rows.Count, 2).End(xlUp).Row

    Worksheets("Practices").Cells(b + 1, 2).Select 'column To paste data into

    ActiveSheet.Paste

    Worksheets("Home").Activate

    ElseIf Worksheets("Home").Cells(i, 4).Value = "Active" And Worksheets("Home").Cells(i, 3).Value = "Netherlands" Then

    C = Worksheets("Home").Cells(i, 2).Copy

    Worksheets("Practices").Activate

    b1 = Worksheets("Practices").Cells(Rows.Count, 4).End(xlUp).Row

    Worksheets("Practices").Cells(b1 + 1, 4).Select

    ActiveSheet.Paste

    Worksheets("Home").Activate

    ElseIf Worksheets("Home").Cells(i, 4).Value = "Active" And Worksheets("Home").Cells(i, 3).Value = "UK" Then

    C = Worksheets("Home").Cells(i, 2).Copy

    Worksheets("Practices").Activate

    b = Worksheets("Practices").Cells(Rows.Count, 6).End(xlUp).Row

    Worksheets("Practices").Cells(b + 1, 6).Select

    ActiveSheet.Paste

    Worksheets("Home").Activate
    End If

Next

End Sub

如何使这更简洁？

Answer 1

我建议减少这样的冗余代码：

请不要像我在第一条评论中所说的那样使用.Select和.Activate How to avoid using Select in Excel VBA
使用Option Explicit确保声明所有变量。
不要反复使用相同的代码行。而是像我下面所做的那样制作一个功能/程序或减少冗余。
始终使用描述性变量名称而不是单个字母名称。否则你的代码很难被人类阅读/理解。

Option Explicit

Public Sub SortData()
    'Clear Data from Practices Sheet
    Worksheets("Practices").Range("B6:F1000").Clear

    Dim LastUsedRow As Long
    LastUsedRow = Worksheets("Home").Cells(Rows.Count, 3).End(xlUp).Row

    Dim i As Long
    For i = 3 To LastUsedRow
        If Worksheets("Home").Cells(i, 4).Value = "Active" Then
            Dim PasteColumn As Long

            Select Case Worksheets("Home").Cells(i, 3).Value
                Case "Denmark":        PasteColumn = 2 
                Case "Netherlands":    PasteColumn = 4
                Case "UK":             PasteColumn = 6
                Case Else:             PasteColumn = 0 'we need this to cancel copy
            End Select

            If PasteColumn > 0 Then
                Dim PasteLastRow As Long
                PasteLastRow = Worksheets("Practices").Cells(Rows.Count, PasteColumn).End(xlUp).Row

                Worksheets("Home").Cells(i, 2).Copy
                Worksheets("Practices").Cells(PasteLastRow + 1, PasteColumn).Paste
            End If
        End If
    Next i
End Sub

Answer 2

我已经知道你的意思了。但是正如评论中所指出的那样，整个过程中存在许多错误和不一致。

Sub SortData()
    Dim a As Long, c As Range, sh  As Worksheet, ws As Worksheet, b As Long

    Set sh = ThisWorkbook.Sheets("Home")
    Set ws = ThisWorkbook.Sheets("Practices")
    a = sh.Cells(Rows.Count, 3).End(xlUp).Row

    For i = 3 To a
        If sh.Cells(i, 4).Value = "Active" Then
            Set c = sh.Range(Cells(i, "A"), Cells(i, "D"))
        End If

        If c.Columns(3) = "Denmark" Then
            b = ws.Cells(Rows.Count, 5).End(xlUp).Row
            c.Copy
            ws.Cells(i, 2).PasteSpecial
        ElseIf c.Cells(i, 3) = "Netherlands" Then
            b = ws.Cells(Rows.Count, 5).End(xlUp).Row
            c.Copy
            ws.Cells(i, 2).PasteSpecial
        ElseIf C.Cells(i, 3) = "UK" Then
            b = ws.Cells(Rows.Count, 5).End(xlUp).Row
            c.Copy
            ws.Cells(b + 1, 6).PasteSpecial
        End If
    Next
End Sub

选择特定列VBA COPY

2 个答案: