1

私は VBA の初心者で、コードに IF ELSE ステートメントを追加する方法を考えています。

コード：

Private Sub CommandButton3_Click()

 Application.ScreenUpdating = False

    Dim NextRow As Range

    Sheet1.Range("F7,F10,F13,F16,F19,F22,F25,F28").Copy

    Sheets("Overzicht").Select
    Set NextRow = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)
    NextRow.Select
    Selection.PasteSpecial (xlValues), Transpose:=True

    MsgBox "Invoer is opgeslagen"

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub
4

1 に答える 1

0

へようこそstackoverflow.com

、ステートメントと型変数copy code blockでラップする必要があります。for loopIF-ELSEBoolean

まず、指定した範囲のセルを繰り返し処理し、それらがすべて満たされていることを確認します

 Dim allFilled As Boolean
    Dim i As Long
    For i = 7 To 28 Step 3
        If Not IsEmpty(Sheet1.Range("F" & i)) Then
            allFilled = True
        Else
            allFilled = False
        End If
    Next i

それらが存在する場合は、コピーして貼り付けを続行できます。そうでない場合、プログラムはメッセージ ボックスを表示します。Not all the cells are filled! Cant copy

あなたの完全なコード:

Sub CommandButton3_Click()
 Application.ScreenUpdating = False

    Dim allFilled As Boolean
    Dim i As Long
    For i = 7 To 28 Step 3
        If Not IsEmpty(Sheet1.Range("F" & i)) Then
            allFilled = True
        Else
            allFilled = False
        End If
    Next i

    If allFilled Then ' = if (allFilled = true) then
        Dim NextRow As Range
        Sheet1.Range("F7,F10,F13,F16,F19,F22,F25,F28").Copy

        Sheets("Overzicht").Select
        Set NextRow = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp). _ 
                      Offset(1, 0)
        NextRow.Select
        Selection.PasteSpecial (xlValues), Transpose:=True

        MsgBox "Invoer is opgeslagen"

        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    Else
        MsgBox "Not all the cells are filled! Cant copy"
    End If
End Sub

Update、コメントから:

はい、さまざまなチェックを個別に実行することもできます。たとえば、次のようになります。

Dim allFilled As Boolean
If Not IsEmpty(Range("F7, F10, F13, F16")) And IsEmpty(Range("F8")) Then
    ' F7, F10, F13, F16 are not empty and F8 is empty
    allFilled = True
ElseIf IsEmpty(Range("F28")) Then
    ' F28 empty cannot execute copy-paste
    allFilled = False
Else
    allFilled = False
End If
于 2013-07-25T10:44:30.997 に答える