Question

这个难题现在让我感到紧张，作为一个开始的VBA Excel用户，他有很多想要自动化的东西......（也许有点过于雄心勃勃:)）

我迄今为止所做的事情是：为每家公司创建一个包含所有当前可用数据的工作表的新文件。一个控制表，我可以在其中选择哪个利益相关者应该接收哪些表格，以及何时发送文本。这一切都很好，但我想在数据中添加图表，以显示随着时间的推移会发生什么。

问题是： - 每月循环遍历一组可变数据，添加了一个新列，因此列的范围应该灵活。 - 每个公司的行数不是预先定义的，可能会逐月变化 - 创建工作表的公司数量也可能不同

我的意图是： - 为D列中的每个唯一值创建图形 - 使用D列中的唯一值命名图形（标题） - 在A栏中将新创建的标签命名为公司名称（让我们说：＆＃39;公司A - 图表＆＃39;作为工作表名称） - 在一张表中包括当前表格中的所有图表（当前表格中的信息是一家公司） - 转到下一张纸并执行相同（循环）直到完成所有纸张 - 添加另一个工作表，其中包含当前在文件中的所有工作表名称（现有+已创建） - Y值的标签位于G列（＆＃39;名称＆＃39;） - Y值位于H列中，进一步位于第2行并且一直向下（灵活） - 标题在第1行 - ＆gt;只有月份（H>＆gt;）应包括在X轴上 - 因此，A：F列中的信息不应用于上述

之外的其他信息

我有一段剧本，但我在一条死胡同里。非常感谢任何帮助！

如果您有任何疑问，请告知我们。

许多人提前感谢！

Wouter： - ）

P.S。：这是文件：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

VBA Excel：从多个工作表的灵活范围创建唯一值的图形

0 个答案: