VBA Excel:为多个工作表的灵活范围创build唯一值的graphics

这个难题现在让我感到很紧张,作为一个开始VBA Excel用户,有很多雄心勃勃的事情…(也许有点太野心:))

我已经pipe理的东西是:为每个公司创build一个包含所有当前可用数据的工作表的新文件。 一个控制表,我可以select哪个利益相关者应该收到哪些表,哪些文本和何时。 这一切工作正常,但我想添加graphics的数据,以显示随着时间的推移。

问题是: – 每个月循环一组variables数据,添加一个新的列,所以列的范围应该是灵活的。 – 每个公司的行数不是预先定义的,并且可能与上个月有所不同 – 创build工作表的公司的数量也可能不同

我的目的是: – 在D列中为每个唯一值创build图表 – 在列D中用唯一值命名graphics(标题) – 在列A中命名公司名称的新创build选项卡(假设:公司A – graphics“作为图纸名称) – 在一张纸上包含当前纸张的所有graphics(当前纸张上的信息是一家公司的) – 转到下一张纸张并执行相同的操作(循环),直到所有纸张都完成 – 添加另一个工作表,其中包含当前在文件中的所有工作表名称(已存在+已创build) – Y值的标签位于G列(“名称”) – Y值位于列H中, 2和一直向下(灵活) – 标题在第1行 – >只有月(H >>)应该包含在X轴上 – 所以不应该使用A:F列中的信息除了上面提到的

我得到了一个剧本,但我在一条死路上。 任何帮助将非常感激!

如果您有任何问题,请告诉我。

很多人提前感谢!

Wouter 🙂

PS:这是文件: http : //we.tl/786d6b6cs0

Sub WJS_CreateGraphs() Response = MsgBox("Are you sure you want to create graphs for all worksheets?", vbYesNo, "Graph Creator") If Response = vbNo Then Exit Sub End If ' ------------------------------------ Now we will create pivot tables for all scenario's Dim WS_Count As Integer Dim C As Integer ' Set WS_Count equal to the number of worksheets in the active workbook. WS_Count = ActiveWorkbook.Worksheets.Count ' Begin the loop. For C = 1 To WS_Count Dim I As Integer Dim selecta As Range Dim grFilter As Range, grUniques As Range Dim grCell As Range, grCounter As Integer Dim arow As Integer Dim acol As Integer Dim StartPoint As Integer Dim EndPoint As Integer Dim rStartPoint As Integer Dim rEndPoint As Integer ActiveSheet.Range("D1").Select Set selecta = Range(Selection, ActiveCell.SpecialCells(xlLastCell)) Set grFilter = Range("D1", Range("D" & Rows.Count).End(xlUp)) With grFilter ' Filter column A to show only one of each item (uniques) in column A .AdvancedFilter Action:=xlFilterInPlace, Unique:=True ' Set a variable to the Unique values Set grUniques = Range("D2", Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible) ' Filter, Copy, and Paste each unique to its' own sheet in the new workbook For Each cell In grUniques counter = counter + 1 'NOTE - this filter is on column D(field:=1), to change 'to a different column you need to change the field number relative to the Unique Value range above grFilter.AutoFilter field:=1, Criteria1:=cell.Value '******************************************************************************************************************************** temp_StartPoint = 2 temp_EndPoint = ActiveSheet.UsedRange.Rows.Count For arow = temp_StartPoint To temp_EndPoint StartPoint = 2 EndPoint = ActiveSheet.UsedRange.Rows.Count FirstColumn = 7 LastColumn = ActiveSheet.UsedRange.Columns.Count ' remember the sheet to return to, this is the current active sheet --> after creating a graph VBA will return to this sheet MyPrevSheet = ActiveSheet.name Charts.Add ActiveChart.ChartArea.Select ActiveChart.ChartType = xlLine 'Type of graph ' Return to previous sheet If Len(MyPrevSheet) > 0 Then Sheets(MyPrevSheet).Activate Else MsgBox "You have not switched sheets yet since opening the file!" End If ActiveChart.SetSourceData Source:=Range(Cells(StartPoint, FirstColumn) & ":" & Cells(EndPoint, LastColumn)) ', PlotBy:=xlRows 'data source ActiveChart.SeriesCollection(1).XValues = ActiveSheets.Range(FirstColumn & "1:" & Cells(LastColumn, 1)) 'naming the x-axis ActiveChart.SeriesCollection(1).name = "Spwr" ' Name of 1st data series 1 ActiveSheet.ShowAllData On Error Resume Next With ActiveChart.SeriesCollection(1) 'put labels on 1st data series .HasDataLabels = True .DataLabels.NumberFormat = "##" End With With ActiveChart.Axes(xlValue) .HasMajorGridlines = False .HasMinorGridlines = False End With ActiveChart.PlotArea.Select ' Background of graph With Selection.Border .ColorIndex = 16 .Weight = xlThin .LineStyle = xlContinuous End With Selection.Interior.ColorIndex = xlNone ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(2).name = "salespower" ActiveChart.SeriesCollection(2).Values = ActiveSheets.Range("G2:m2") With ActiveChart.SeriesCollection(2) 'put labels on 2nd line .HasDataLabels = True .DataLabels.NumberFormat = "##" End With ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(3).name = "Tests" ActiveChart.SeriesCollection(3).Values = ActiveSheets.Range("G2:m2") With ActiveChart.SeriesCollection(3) 'put labels on 3rd line .HasDataLabels = True .DataLabels.NumberFormat = "##" End With ActiveChart.Legend.Position = xlLegendPositionBottom ActiveChart.HasTitle = True ChartTitle = "Naam van de chart" Next arow Next cell rngFilter.Parent.AutoFilterMode = False Application.ScreenUpdating = True '*********************************************************************************************************************************************** End With Next C End Sub