У меня есть этот код до сих пор, и в конце этого кода мне нужно идентифицировать memberID, который является комбинацией ParticipantID с объединением _1, _2, _3, _4, _5, 6… et c.… Чтобы определить назначение « #», я определил «Счет участника», который имеет Участник. То, что я пытаюсь сделать, это вставить конкатенацию в отфильтрованный диапазон для указанного столбца. Например, когда отфильтровано по элементу Num Count = 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
'Создать набор зависимых идентификаторов 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