gpt4 book ai didi

vba - 使用 Vba 迭代数据透视表,同时将单个字段复制到单独的工作表中

转载 作者:行者123 更新时间:2023-12-02 01:13:06 24 4
gpt4 key购买 nike

我使用的是 Excel 2013,我有一个包含数百个过滤器值的数据透视表,我需要迭代这些过滤器值,使每个值单独可见,然后复制过滤后的值和特定单元格(非数据透视表和 IF > 0)并将其粘贴(仅值)到指定的工作表中,然后移动到下一个数据透视项并执行相同的操作。我找到了一些与我想要的类似的代码

Sub PivotStockItems()
Dim i As Integer
Dim sItem As String
Application.ScreenUpdating = False
With ActiveSheet.PivotTables("PivotTable1")
.PivotCache.MissingItemsLimit = xlMissingItemsNone
.PivotCache.Refresh
With .PivotFields("Country")
'---hide all items except item 1
.PivotItems(1).Visible = True
For i = 2 To .PivotItems.Count
.PivotItems(i).Visible = False
Next
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = True
If i <> 1 Then .PivotItems(i - 1).Visible = False
sItem = .PivotItems(i)
Cells.Copy
Workbooks.Add
With ActiveWorkbook
.Sheets(1).Cells(1).PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats
.SaveAs "C:\TEST\MyReport-" & sItem & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook
.Close
End With
Next i
End With
End With

结束子但是,我知道我需要删掉

Cells.Copy
Workbooks.Add
With ActiveWorkbook
.Sheets(1).Cells(1).PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats
.SaveAs "C:\TEST\MyReport-" & sItem & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook
.Close

我只是不知道要添加什么来复制某个单元格(非数据透视)并将其粘贴到另一个工作表中(假设它满足 >0 标准)。我对 VBA 比较陌生,我正在努力提高我的技能。

添加屏幕截图以供引用本质上,我想迭代 B3(数据透视表)并将 B3 和 F46 复制到下图所示的新工作表中(如果 F46>0)。 :

Pivot Table Sheet to Copy to谢谢。

最佳答案

这应该适合你。您将需要调整数据透视表和数据表名称,如下所示。

Sub PivotStockItems()
Dim i As Integer
Dim sItem As String
Dim pivotSht As Worksheet, dataSht As Worksheet

Set pivotSht = Sheets("test") 'adjust to the name of sheet containing your pivot table
Set dataSht = Sheets("SKUS_With_Savings") 'as per your image

Application.ScreenUpdating = False
With pivotSht.PivotTables("PivotTable1")
.PivotCache.MissingItemsLimit = xlMissingItemsNone
.PivotCache.Refresh
With .PivotFields("Yes")
'---hide all items except item 1
.PivotItems(1).Visible = True
For i = 2 To .PivotItems.Count
.PivotItems(i).Visible = False
Next
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = True
If i <> 1 Then .PivotItems(i - 1).Visible = False
sItem = .PivotItems(i)

'this takes care of the condition and copy-pasting
If pivotSht.Range("F46").Value > 0 Then
dataSht.Cells(getLastFilledRow(dataSht) + 1, 1).Value = sItem
dataSht.Cells(getLastFilledRow(dataSht), 2).Value = pivotSht.Range("F46").Value
Else: End If

Next i
End With
End With
End Sub

'gets last filled row number of the given worksheet
Public Function getLastFilledRow(sh As Worksheet) As Integer
On Error Resume Next
getLastFilledRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

关于vba - 使用 Vba 迭代数据透视表,同时将单个字段复制到单独的工作表中,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/43354564/

24 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com