VBA根据过滤后的数据创建图表

时间:2019-02-08 11:10:00

标签: excel vba charts

我将来自不同来源的数据集合并到一张Excel工作表中,目的是自动创建图表。但是,根据工作表上“复选框”的状态,“图表”在两种状态下都应仅包括表的过滤集。

为了给您更好的印象,我的桌子看起来像这样: enter image description here

因此,选中该框时,请过滤G列中的数据,然后从剩余的行中构建图表。如果未选中,则过滤其他数字等。

S列中的值通过公式计算。所以总的来说,我的方法看起来像这样:

Sub Analysis()

Dim ws As Worksheet
Set ws = ActiveSheet

'Clear worksheet data
ws.Range("A2:R" & CStr(ws.UsedRange.Rows.Count)).Clear

'Copy data from source files to active sheet

Dim lngRows as long
lngRows = ws.UsedRange.Rows.Count

'##########################################################################
'Apply filters according to checkbox on sheet
'If only supplier parts checked, filter according to column "Beschaffungsart"

'Has checkbox been checked to only regard parts from supplier?
Dim onlySupplierParts As Boolean
onlySupplierParts = CBool(ws.Cells(9, ColC2N("U")).Text = "WAHR")

If onlySupplierParts Then
    ws.Range("$A$1:$S$" & CStr(lngRows).AutoFilter Field:=1
    ws.Range("$A$1:$S$" & CStr(lngRows).AutoFilter Field:=17, Criteria1:="F"
Else
    'don't filter for supplier parts, only filter empty rows
    ws.Range("$A$1:$S$" & CStr(lngRows).AutoFilter Field:=17
    ws.Range("$A$1:$S$" & CStr(lngRows).AutoFilter Field:=1, Criteria1:="<>"

    'ATTENTION: if not filtered for supplier parts, filter accordingly
    ws.Range("$A$1:$S$" & CStr(lngRows).AutoFilter Field:=7, Criteria1:=Array("101", "102", "103"), Operator:=xlFilterValues
End If
'##########################################################################


'Sort retrieved data according to date column
[...]

'Apply sum formula to column S
Range("S2").Select
ActiveCell.FormulaR1C1 = "=RC[-7]"
Range("S3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+RC[-7]"
Range("S3").Select
Selection.AutoFill Destination:=Range("S3:S" & CStr(Worksheets("Warenbewegungen").UsedRange.Rows.Count - 4)), Type:=xlFillDefault

'Delete old chart
Dim chtobj As ChartObject
For Each chtobj In ws.ChartObjects
   chtobj.Delete
Next chtobj

'Add chart
Dim rng As Range
Set rng = ws.Range("B6:P70")
Set chtobj = ws.ChartObjects.Add(Left:=rng.Left, Width:=rng.Width, Top:=rng.Top, Height:=rng.Height)
chtobj.Chart.ChartType = xlLine
chtobj.Chart.HasTitle = True
chtobj.Chart.ChartTitle.Text = "Verlauf Lagerbestand"

With chtobj.Chart.SeriesCollection.NewSeries
   .Name = "Progress over time"
   .Values = ws.Range("S2:S" & CStr(lngRows))
   .XValues = ws.Range("I2:I" & CStr(lngRows))
End With

End Sub

现在,我的问题是图表所包含的范围不限于应用过滤器后仍可见的单元格。

我曾考虑过将整个数据集保存在一个数组中并“手动”对其进行过滤,但是我确实感觉这效率极低。关于该主题的研究表明,应该使用xlSpecialCells解决方案,但是对我来说,这还不是很清楚://

我肯定有一个优雅的解决方案,我感谢任何提示。 谢谢您的时间和帮助!

2 个答案:

答案 0 :(得分:0)

默认情况下,图表不会在表的隐藏行中绘制数据。只需使用表的所有行制作图表,过滤表后,将隐藏某些行,并且不会绘制这些行。

答案 1 :(得分:0)

我决定过滤整个工作表,将剩余数据保存在数组中,清除数据,然后将数组再次粘贴到工作表上。在途中,我首先使用

ws.Range("A1:S" & CStr(lngRows)).AutoFilter Field:=7, Criteria1:=Array("101", "601", "643"), Operator:=xlFilterValues

'save current data in array, ONLY VISIBLE DATA!
filteredSet = ws.Range("A1:R" & lngRows).SpecialCells(xlCellTypeVisible)

'Clear worksheet data, then paste filteredSet to worksheet
ws.Range("A1:S" & lngRows).ClearContents
ws.Range("A1:R" & CStr(UBound(filteredSet, 1))).value = filteredSet

但是,在某些情况下,SpecialCells(xlCellTypeVisible)似乎是不依赖的(例如here),因为它没有返回正确过滤的数据集。经过一番研究,我通过以下方式将其替换:

ws.Range("A1:S" & lngRows).AutoFilter Field:=7, Criteria1:=Array("101", "601", "643"), Operator:=xlFilterValues

'save current data in array, ONLY VISIBLE DATA!
filteredSet = VisibleCells(ws.Range("A2:S" & lngRows))

'Clear worksheet data, then paste filteredSet to worksheet
ws.Range("A1:S" & lngRows).AutoFilter Field:=7
ws.Range("A2:S" & lngRows).Clear
ws.Range("A2:S" & CStr(UBound(filteredSet, 1))).value = filteredSet



Private Function VisibleCells(rng As Range) As Range
Dim r As Range
For Each r In rng.Rows
    If r.EntireRow.Hidden = False Then
        If VisibleCells Is Nothing Then
            Set VisibleCells = r
        Else
            Set VisibleCells = Union(VisibleCells, r)
        End If
    End If
Next r
End Function

但是在大​​多数情况下,filteredSet仍然不是应用过滤器时仍然可见的数据。我在做什么错了?