Question

我有一个宏可以很好地粘贴一个列中的数组，现在我想在第二列中粘贴一个新数组，问题是粘贴它所具有的值以满足某些条件，所以我必须嵌套在另一个内部的if条件，它没有给我任何错误，但它没有工作...... 这就是我所拥有的：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A, L:L")) Is Nothing Then
        On Error GoTo Fìn
        Application.EnableEvents = False
        Dim i As Long, n As Long
        Dim arrmatrix As Variant
        ReDim arrmatrix(1 To 1, 1 To 1)
        For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
            If Cells(i, 12).Value = "Pi emitida" Then
                n = n + 1
                ReDim Preserve arrmatrix(1 To 1, 1 To n)
                arrmatrix(1, n) = Cells(i, 1).Value
            End If
        Next i
        With Worksheets("Inicio")
            .Range("G4:G" & Rows.Count).ClearContents
            .Range("G4").Resize(UBound(arrmatrix, 2), 1) =   Application.Transpose(arrmatrix)
        End With
    End If
    If Not Intersect(Target, Range("A:A, Q:Q,L:L")) Is Nothing Then
        On Error GoTo Fìn
        Application.EnableEvents = False
        Dim j As Long, m As Long
        Dim arrmatrix1 As Variant
        ReDim arrmatrix1(1 To 1, 1 To 1)
        For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row
            'THIS IS THE PROBLEM.....!!!!!!!!!!!!!!!
            If Cells(j, 12).Value = "Pi emitida" Or Cells(j, 12).Value = "PI    firmada" Or Cells(j, 12).Value = "Carta credito L/c" Or Cells(j, 12).Value =  "Con booking" Then
                If DateDiff(d, Cells(j, 17).Value, Today) > 0 Then
                    m = m + 1
                    ReDim Preserve arrmatrix1(1 To 1, 1 To m)
                    arrmatrix1(1, m) = Cells(j, 1).Value
                End If

        Next j
        With Worksheets("Inicio")
            .Range("H4:H" & Rows.Count).ClearContents
            .Range("H4").Resize(UBound(arrmatrix1, 2), 1) =    Application.Transpose(arrmatrix1)
        End With
    End If

Fìn:
    Application.EnableEvents = True
End Sub

Answer 1

试试这个：

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A, L:L")) Is Nothing Then
    On Error GoTo Fìn
    Application.EnableEvents = False
    Dim i As Long, n As Long
    Dim arrmatrix As Variant
    ReDim arrmatrix(1 To 1, 1 To 1)
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 12).Value = "Pi emitida" Then
            n = n + 1
            ReDim Preserve arrmatrix(1 To 1, 1 To n)
            arrmatrix(1, n) = Cells(i, 1).Value
        End If
    Next i
    With Worksheets("Inicio")
        .Range("G4:G" & Rows.Count).ClearContents
        .Range("G4").Resize(UBound(arrmatrix, 2), 1) =   Application.Transpose(arrmatrix)
    End With
    End If
    If Not Intersect(Target, Range("A:A, Q:Q,L:L")) Is Nothing Then
    On Error GoTo Fìn
    Application.EnableEvents = False
    Dim j As Long, m As Long
    Dim arrmatrix1 As Variant
    ReDim arrmatrix1(1 To 1, 1 To 1)
    For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row

  'THIS IS THE PROBLEM.....!!!!!!!!!!!!!!!
    If Cells(j, 12).Value = "Pi emitida" Or Cells(j, 12).Value = "PI    firmada" Or Cells(j, 12).Value = "Carta credito L/c" Or Cells(j, 12).Value =  "Con booking" Then
        If DateDiff(d, Cells(j, 17).Value, Today) > 0 Then

            m = m + 1
            ReDim Preserve arrmatrix1(1 To 1, 1 To m)
            arrmatrix1(1, m) = Cells(j, 1).Value
        End If

    End If    
    Next j
    With Worksheets("Inicio")
        .Range("H4:H" & Rows.Count).ClearContents
        .Range("H4").Resize(UBound(arrmatrix1, 2), 1) =    Application.Transpose(arrmatrix1)
    End With


 Fìn:
Application.EnableEvents = True
End Sub

如何将if条件嵌入另一个条件中

1 个答案: