在已过滤的单元格上复制和粘贴公式

时间:2020-03-12 23:32:44

标签: excel vba office365

到目前为止,我已经有了这段代码,在此代码的结尾,我需要标识memberID,该成员ID是ParticipantID与_1,_2,_3,_4,_5, 6…等串联的组合。为了确定“ #”分配,我确定了会员拥有的“参与者ID计数”。我正在或尝试做的是将串联连接粘贴到指定列的过滤范围内。例如,当根据“会员数量计数” = 5进行过滤时:

Participant ID  Member Num Count    Concate
002162                 5            002162_1
002162                 5            002162_2
002162                 5            002162_3
002162                 5            002162_4
002162                 5            002162_5
002210                 5            002210_1
002210                 5            002210_2
002210                 5            002210_3
002210                 5            002210_4
002210                 5            002210_5

我觉得我已经很接近完成这个任务了,我只是想念一些东西。

Sub CreatePivotTable()

    Dim PTCache As PivotCache
    Dim pt As Variant
    Dim WS As Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Pivot").Delete
    On Error GoTo 0

    With Workbooks("Formatting.xlsm").Sheets("Dependants")
        .Range("A1").End(xlToRight).Offset(, 1).Value = "Count"
        .Range("A1").End(xlToRight).Offset(, 1).Value = "DependantID"
        .Range("A1").EntireColumn.Insert (xlShiftToLeft)
        .Range("A1").Value = "Concate"
        .Cells.AutoFilter
        .Range("B1").End(xlDown).Offset(0, -1).Activate
        ActiveCell.FormulaR1C1 = "=CONCAT(RC[1],""|"",RC[10])"
        With ActiveCell
            .Copy
            .End(xlUp).Offset(1, 0).Select
        End With
        Range(Selection, Selection.End(xlDown)).Select
        ActiveSheet.Paste

        .Range("B1").EntireColumn.NumberFormat = "000000"
        ActiveCell.EntireColumn.Copy
    End With

    With Workbooks("Formatting.xlsm")
        .Sheets.Add After:=ActiveSheet
        .ActiveSheet.Name = "Working"
        .ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
        Sheets("Working").Columns("A:A").Activate
        ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
    End With

    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    With Worksheets("Working")
        .Range("B1").Value = "Dependent Num"
        .Range("A1").Value = "Participant ID"
    End With

    Set PTCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
        SourceData:=Sheets("Working").Range("A1").CurrentRegion)

    Worksheets.Add
    ActiveSheet.Name = "Pivot"

    Set pt = ActiveSheet.PivotTables.Add(PivotCache:=PTCache, TableDestination:=Range("A3"))

    With pt
        .PivotFields("Participant ID").Orientation = xlRowField
        .PivotFields("Dependent Num").Orientation = xlDataField
        .RowGrand = False
        .ColumnGrand = False
        Subtotals = False
    End With

    Range("B3").Select
    With ActiveSheet.PivotTables(1).PivotFields("Sum of Dependent Num")
        .Caption = "Count of Dependent Num"
        .Function = xlCount
    End With

    With Worksheets("Pivot")
        .Range("A3").CurrentRegion.Copy
        .Range("E3").PasteSpecial Paste:=xlPasteValues
        .Range("E:E").NumberFormat = "000000"
    End With

    Worksheets("Dependants").Activate
    Range("A1").End(xlToRight).Offset(1, 0).Activate
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-18],Pivot!C4:C5,2,)"

    Range("S1").End(xlDown).Offset(, 1).Activate
    With ActiveCell
        .FormulaR1C1 = "=VLOOKUP(RC[-18],Pivot!C5:C6,2,)"
        .Copy
        .End(xlUp).Offset(1, 0).Select
    End With

    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste

    Range("T:T").Copy
    Range("T:T").PasteSpecial Paste:=xlPasteValues

    Sheets("Pivot").Activate
    Range("B3").Activate

    Dim pf As PivotField
    On Error Resume Next
    For Each pt In ActiveSheet.PivotTables
    For Each pf In pt.PivotFields
    'First, set index 1 (Automatic) to True,
    'so all other values are set to False
    pf.Subtotals(1) = True
    pf.Subtotals(1) = False
    Next pf
    Next pt

    Set pvttbl = ActiveSheet.PivotTables(1)

    With ActiveSheet.PivotTables(1)
        On Error Resume Next
        .PivotFields("Count of Dependent Num").Orientation = xlHidden
        On Error GoTo 0
        .PivotFields("Dependent Num").Orientation = xlRowField
        .RowAxisLayout xlTabularRow
        .RepeatAllLabels xlRepeatLabels
        .ColumnGrand = False
        .RowGrand = False
    End With

    Sheets("Pivot").Activate
    Range("A3").CurrentRegion.Copy
    Range("H3").PasteSpecial Paste:=xlPasteValues
    Range("H:H").NumberFormat = "000000"
    Range("H3").End(xlToRight).Offset(0, 1).Value = "Dependent Count"
    Range("J4").Activate
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],C5:C6,2,)"
    ActiveCell.Copy
    Range("I3").End(xlDown).Offset(0, 1).Activate
    Range(Selection, Selection.End(xlUp)).Offset(1, 0).Select
    ActiveSheet


    'ActiveSheet.Range("H:K").AutoFilter Field:=2, Criteria1:="0"
    'Range("I3").End(xlDown).Select
    'Range(Selection, Selection.End(xlUp)).Offset(1, 0).ClearContents

    'ActiveSheet.Range("H3:K3").AutoFilter
    'ActiveSheet.Range("H3:K3").AutoFilter

    With ActiveSheet.Range("H3").CurrentRegion
    .AutoFilter Field:=3, Criteria1:="1"
    If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
        With .Columns(4)
            .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=CONCAT(""00"",RC[-3],""_1"")"
        End With
    End If
End With

'创建DependentID 设置WS = Worksheets(“ Pivot”)

WS.Range("H:K").AutoFilter Field:=3, Criteria1:="2"
WS.Range("J3").End(xlDown).Offset(0, 1).Activate
ActiveCell.FormulaR1C1 = "=CONCAT(""00"",RC[-3],""_2"")"
WS.Range("K3").End(xlDown).Offset(-1, 0).Activate
ActiveCell.FormulaR1C1 = "=CONCAT(""00"",RC[-3],""_1"")"
Range(Selection, Selection.End(xlDown)).Copy
WS.Range(Selection, Selection.End(xlUp)).SpecialCells(xlCellTypeVisible).Offset(2, 0).Activate
WS.Paste
WS.Range("J3").End(xlDown).Offset(0, 1).Activate
ActiveCell.End(xlUp).Offset(-2, 0).Activate
WS.Paste

'这是我的代码失败的地方。我正在尝试将公式粘贴到具有3的过滤器的单元格中。如前所述,我需要通过每个成员存在的成员数来获得1。

WS.Range("H:K").AutoFilter Field:=3, Criteria1:="3"
WS.Range("J3").End(xlDown).Offset(0, 1).Activate
ActiveCell.FormulaR1C1 = "=CONCAT(""00"",RC[-3],""_3"")"
WS.Range("K3").End(xlDown).Offset(-1, 0).Activate
ActiveCell.FormulaR1C1 = "=CONCAT(""00"",RC[-3],""_2"")"
WS.Range("K3").End(xlDown).Offset(-1, 0).Activate
ActiveCell.FormulaR1C1 = "=CONCAT(""00"",RC[-3],""_1"")"
Range(Selection, Selection.End(xlDown)).Copy

WS.Range(Selection, Selection.End(xlUp)).SpecialCells(xlCellTypeVisible).Offset(3, 0).Activate
WS.Paste

End Sub

0 个答案:

没有答案