vba - ネストされた If ステートメントに問題がある

Question

私は VBA を初めて使用し、作成しようとしているマクロで If ステートメントを使用するのに苦労しています。毎月、当社のどの従業員が特定のタスクを実行したかを示す Excel のレポートを受け取ります。私が書いているマクロは、各従業員のデータをマスターブックの名前の下にコピーアンドペーストするためのものです。

私が直面している問題は、コピーする必要がある範囲を定義することです。コードでわかるように、従業員は列 B にリストされています。まず、列 B で従業員を検索します。従業員が存在しない場合、マクロはマスターブックの従業員の名前の下に (なし) をコピーして貼り付けます。 . 名前が見つかった場合は、その名前の下の行を最初の変数として設定します。

ここで私は問題に遭遇します。次のステップは、リストされている次の従業員を見つけ、上の行を 2 番目の変数として設定することです。次に、1 番目と 2 番目の変数を使用して、その範囲の行をコピーして貼り付けます。If ステートメントを使用して循環し、リストされている次の従業員を見つけています。ただし、ネストされた If ステートメントは、2 番目の 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

よろしくお願いします。追加のコンテキストを提供できるかどうか教えてください。

score 1 · Accepted Answer

気になった点をいくつか。

.Activateやは使用しないでくださいSelection。オブジェクトを直接操作します。あなたはこれを見たいかもしれません
使用している場合は.Find、一致が見つからない場合に備えてください。あなたはいくつかの場所でそれをしましたが、いくつかで失敗しました。
などを宣言Employee1しないでください。Excel 2007 以降では、Excel 2007 以降では 1048576 行がサポートされているため、エラーが発生する可能性があります。代わりに使用します。Employee2IntegerLong
EmployeeRangeどこにも貼り付けるつもりがないのに、なぜ範囲をコピーしているのかわかりませんか? PasteRangeを宣言しているようですが...

このコードを参照してください。これはあなたがしようとしていることですか？(未テスト)

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

vba - ネストされた If ステートメントに問題がある

1 に答える 1

Related

Reference