Question

我有一个脚本循环通过主表单寻找＆＃34; X＆＃34;在某些列中将信息填充到不同的子表中。＆＃34;该脚本绑定到命令按钮。

脚本工作得很好，但是我试图弄清楚在输入值之前如何首先检查记录是否已存在于子表中。如果记录存在，我希望脚本跳过添加记录。

此外，我需要脚本来检查是否已从主工作表中删除了X，这应该从子工作表中删除该记录。

就像现在一样，每次点击按钮时都会添加相同的记录，如果从主列中删除了X，则记录会保留在子表中。

这是我到目前为止所做的：

Sub PopulateAgents()

Dim c As Range
With Sheets("MASTER")

    For Each c In .Range("AB2:AB" & .Cells(Rows.CountLarge, "AB").End(xlUp).Row)
        If c.Value = "X" Then

            .Range("A" & c.Row & ":F" & c.Row).Copy Sheets("MA").Range("A" & _
                Sheets("MA").Cells(Rows.CountLarge, "A").End(xlUp).Row + 1)
        End If

        Sheets("MA").Columns.AutoFit
    Next c

    For Each c In .Range("AM2:AM" & .Cells(Rows.CountLarge, "AM").End(xlUp).Row)
        If c.Value = "X" Then

            .Range("A" & c.Row & ":F" & c.Row).Copy Sheets("NY").Range("A" & _
                Sheets("NY").Cells(Rows.CountLarge, "A").End(xlUp).Row + 1)
        End If

        Sheets("NY").Columns.AutoFit
    Next c
End With

End Sub

Answer 1

尝试一下：

Sub PopulateAgents()

    Dim wb As Workbook
    Dim wsMaster As Worksheet
    Dim rMasterData As Range
    Dim aTransferParams() As Variant
    Dim i As Long
    Dim lMaxCol As Long

    Set wb = ActiveWorkbook
    Set wsMaster = wb.Sheets("Master")

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '                                                                                                                         '
    '                                            Adjust these parameters as necessary                                         '
    '                                                                                                                         '
    'Change the first "1 to 2" to be "1 to n" where n is the number of sheets you'll be transferring to                       '
    'Leave the second "1 to 2" as is, no need to ever change that                                                             '
     ReDim aTransferParams(1 To 2, 1 To 2)
    '                                                                                                                         '
    'Set to the sheet you'll be transferring to:    Assign the column to be searched for X's    Perform this for each sheet   '
    Set aTransferParams(1, 1) = wb.Sheets("MA"):    aTransferParams(1, 2) = "AB"
    Set aTransferParams(2, 1) = wb.Sheets("NY"):    aTransferParams(2, 2) = "AM"
    '                                                                                                                         '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'Get maximum column
    For i = LBound(aTransferParams, 1) To UBound(aTransferParams, 1)
        If wsMaster.Columns(aTransferParams(i, 2)).Column > lMaxCol Then lMaxCol = wsMaster.Columns(aTransferParams(i, 2)).Column
    Next i

    'Use max column to set master data range
    Set rMasterData = wsMaster.Range(wsMaster.Cells(1, "A"), wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp)).Resize(, lMaxCol)

    'Turn off calcluation, screenupdating, and events to increase code speed and prevent "screen flickering"
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Loop through each transfer paramter
    For i = LBound(aTransferParams, 1) To UBound(aTransferParams, 1)
        'Clear entries in destination sheet
        aTransferParams(i, 1).Range("A1").CurrentRegion.Offset(1).ClearContents

        'Filter for "X" in the appropriate column
        rMasterData.AutoFilter wsMaster.Columns(aTransferParams(i, 2)).Column, "X"

        'Copy over relevant data
        rMasterData.Offset(1).Resize(, 6).Copy aTransferParams(i, 1).Range("A2")
        aTransferParams(i, 1).Columns.AutoFit

        'Remove the filter
        rMasterData.AutoFilter
    Next i

    'Turn calculation, screenupdating, and events back on
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

将数据填充到主表中的子表中

1 个答案: