2

我是 VBA 新手，在尝试编写的宏中使用 If 语句时遇到了一些困难。每个月我都会收到一份 Excel 报告，其中列出了我们公司的哪些员工执行了某些任务。我正在编写的宏旨在将每个员工的数据复制并粘贴到主工作簿中。

我遇到的问题是定义我需要复制的范围。正如您将在代码中看到的那样，员工列在 B 列中。我首先在 B 列中搜索员工。如果他们不存在，宏复制并粘贴（无）在主工作簿中他们的名字下. 如果找到他们的名字，它会将他们名字下面的行设置为第一个变量。

这是我遇到问题的地方。下一步是找到列出的下一个员工，并将上面的行设置为第二个变量。然后我使用第一个和第二个变量来复制和粘贴该范围的行。我正在使用 If 语句循环并查找列出的下一个员工。但是，我的嵌套 If 语句在我的第二个 Else if 语句之后结束。有谁知道我可以写得更好的方法吗？我尝试使用 Select Case 语句，但语法不正确。

Sub EmployeeActivity()

Dim Employee1 As Integer, Employee2 As Integer, Employee3 As Integer, Employee4 As Integer
Dim EmployeeRange As Range, rngSelectFind As Range, rngPasteFind As Range

Windows("Activities Report.xlsm").Activate

Set rngSelectFind = Columns("B:B").Find(What:="Employee 1", After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)

If Not rngSelectFind Is Nothing Then
    Employee1 = rngSelectFind.Row + 1
ElseIf rngSelectFind Is Nothing Then
    Set rngSelectFind = Columns("B:B").Find(What:="(none)", After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    Consultant3 = rngSelectFind.Row
End If

Set rngSelectFind = Columns("B:B").Find(What:="Employee 2", After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)

If Not rngSelectFind Is Nothing Then
    Employee2 = rngSelectFind.Row - 1
ElseIf rngSelectFind Is Nothing Then
    Set rngSelectFind = Columns("B:B").Find(What:="Employee 3", After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not rngSelectFind Is Nothing Then
            Employee2 = rngSelectFind.Row - 1
        End If
ElseIf rngSelectFind Is Nothing Then
    Set rngSelectFind = Columns("B:B").Find(What:="(none)", After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not rngSelectFind Is Nothing Then
            Employee2 = rngSelectFind.Row - 1
        End If
End If

If Employee1 > 0 And Employee2 > 0 Then
    Set EmployeeRange = Range(Cells(Employee1, 2), Cells(Employee2, 7))
ElseIf Employee3 > 0 Then
    Set EmployeeRange = Range(Cells(Employee3, 2), Cells(Employee3, 7))
End If

EmployeeRange.Select
Selection.Copy


Windows("Monthly Activity Report.xlsm").Activate
Sheets("April '13").Activate
Set rngPasteFind = Columns("A:A").Find(What:="Employee Activities", After:=Range("A1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rngPasteFind Is Nothing Then
Employee4 = rngPasteFind.Row + 1
End If

Range(Cells(Employee4, 1), Cells(Employee4, 6)).Select
Selection.Insert (xlShiftDown)


End Sub

预先感谢您的任何帮助。如果我能提供额外的上下文，请告诉我。

4

1 回答 1

1

我注意到的几件事。

  1. 请不要使用.Activate和Selection。直接使用对象。你可能想看这个

  2. 如果您正在使用，.Find则可以在找不到匹配项的情况下进行处理。您已经在几个地方这样做了，但后来又错过了一些。

  3. 不要将Employee1等声明Employee2为Integer. 在 Excel 2007+ 中，这可能会给您一个错误，因为 Excel 2007+ 支持 1048576 行。改为使用Long。

  4. EmployeeRange当您不打算将其粘贴到任何地方时，我不确定您为什么要复制该范围？我看到你正在声明一个Paste范围......

请参阅此代码。这是你正在尝试的吗？（未经测试）

Sub EmployeeActivity()
    Dim Employee1 As Long, Employee2 As Long, Employee3 As Long, Employee4 As Long
    Dim EmployeeRange As Range, rngSelectFind As Range, rngPasteFind As Range
    Dim wb As Workbook, ws As Worksheet
    Dim wb1 As Workbook, ws1 As Workbook

    '~~> Change path as applicable
    Set wb = Workbooks.Open("C:\Activities Report.xlsm")
    '~~> Change this to the relevant sheet
    Set ws = wb.Sheets("Sheet1")

    '~~> Change path as applicable
    Set wb1 = Workbooks.Open("C:\Monthly Activity Report.xlsm")
    Set ws1 = wb.Sheets("April '13")

    With ws
        Set rngSelectFind = .Columns("B:B").Find(What:="Employee 1", _
                            LookIn:=xlValues, LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext)

        If Not rngSelectFind Is Nothing Then
            Employee1 = rngSelectFind.Row + 1
        Else
            Set rngSelectFind = .Columns("B:B").Find(What:="(none)", _
                                LookIn:=xlValues, LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext)

            If Not rngSelectFind Is Nothing Then
                Consultant3 = rngSelectFind.Row
            End If
        End If

        Set rngSelectFind = Nothing

        Set rngSelectFind = .Columns("B:B").Find(What:="Employee 2", _
                             LookIn:=xlValues, LookAt:=xlPart, _
                             SearchOrder:=xlByRows, _
                             SearchDirection:=xlNext)

        If Not rngSelectFind Is Nothing Then
            Employee2 = rngSelectFind.Row - 1
        Else
            Set rngSelectFind = .Columns("B:B").Find(What:="Employee 3", _
                                LookIn:=xlValues, LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext)

            If Not rngSelectFind Is Nothing Then
                Employee2 = rngSelectFind.Row - 1
            Else
                Set rngSelectFind = .Columns("B:B").Find(What:="(none)", _
                                    LookIn:=xlValues, LookAt:=xlPart, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext)
                If Not rngSelectFind Is Nothing Then
                    Employee2 = rngSelectFind.Row - 1
                End If
            End If
        End If

        If Employee1 > 0 And Employee2 > 0 Then
            Set EmployeeRange = .Range(.Cells(Employee1, 2), _
                                       .Cells(Employee2, 7))
        ElseIf Employee3 > 0 Then
            Set EmployeeRange = .Range(.Cells(Employee3, 2), _
                                       .Cells(Employee3, 7))
        End If
    End With

    '~~> I am not sure why are you copying this range???
    If Not EmployeeRange Is Nothing Then EmployeeRange.Copy

    With ws1
        Set rngPasteFind = .Columns("A:A").Find(What:="Employee Activities", _
                           LookIn:=xlValues, LookAt:=xlPart, _
                           SearchOrder:=xlByRows, _
                           SearchDirection:=xlNext)
        If Not rngPasteFind Is Nothing Then
            Employee4 = rngPasteFind.Row + 1
            .Range(.Cells(Employee4, 1), .Cells(Employee4, 6)).Insert (xlShiftDown)
        End If
    End With
End Sub

提示：您可以创建一个.Find可以接受参数的通用函数。这样你就可以大大减少上面的代码；）

编辑

请参阅此示例 ( UNTESTED )，该示例演示了上述提示。这样你就不需要.Find在代码中一次又一次地使用。

Sub EmployeeActivity()
    Dim Employee1 As Long, Employee2 As Long
    Dim Employee3 As Long, Employee4 As Long
    Dim EmployeeRange As Range, rngSelectFind As Range, rngPasteFind As Range
    Dim wb As Workbook, ws As Worksheet
    Dim wb1 As Workbook, ws1 As Workbook

    '~~> Change path as applicable
    Set wb = Workbooks.Open("C:\Activities Report.xlsm")
    '~~> Change this to the relevant sheet
    Set ws = wb.Sheets("Sheet1")

    '~~> Change path as applicable
    Set wb1 = Workbooks.Open("C:\Monthly Activity Report.xlsm")
    Set ws1 = wb.Sheets("April '13")

    With ws
        Employee1 = GetRow(ws, 2, "Employee 1")

        If Employee1 <> 0 Then
            Employee1 = Employee1 + 1
        Else
            Consultant3 = GetRow(ws, 2, "(none)")
        End If

        '
        'And So on
        '
End Sub

Function GetRow(wks As Worksheet, ColNo As Long, SearchString As String) As Long
    Dim rng As Range

    Set rng = wks.Columns(ColNo).Find(What:=SearchString, _
                                LookIn:=xlValues, LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext)

    If rng Is Nothing Then
        GetRow = 0
    Else
        GetRow = rng.Row
    End If
End Function
于 2013-05-06T21:05:39.597 回答