excel - 在过滤的单元格上复制和粘贴公式
问题描述
到目前为止,我有这段代码,在这段代码的末尾,我需要识别成员 ID,它是 ParticipantID 与连接 _1、_2、_3、_4、_5、6等的组合......为了确定“ #' assignment 我已经确定了会员拥有的“参与者 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
'创建 DependentIDs Set 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
解决方案
推荐阅读
- visual-studio-code - 打开外部终端键绑定不起作用
- node.js - fs.d.ts 中的 __promisify__ 如何在设计时工作?
- flutter - `nfc_manager` 需要来自`permission_handler` 的什么许可?
- html - 在滚动条上的引导程序 4 中固定脱离容器的位置
- android - jetpack compose 将参数传递给 viewModel
- node.js - 当我尝试在另一台电脑上运行时,Cors 请求没有成功
- amazon-redshift - 如何更新在 redshift 中用作排序键的列的数据类型?
- spring-boot - 如何使用 EhCache 而不是 ConcurrentHashMap 提供程序
- aspnetboilerplate - ASP.NET Boilerplate 后台作业被放弃
- postgresql - 相关表中的 Hasura 聚合