问题
First and foremost let me just say this website is a godsend!
I have a range of data B2:AS40 for each month. The month is in A2:AS2, within A2:A40 is a list of names, all of this is in 'Sheet1'
After some previous searches on here I have come up with the following, the script makes a new chart for every line, creates a title and puts in the MajorGridlines at 6mth intervals however doesnt plot the data. I cannot for the life of me work out why!!
Please help
Sub test()
Dim Row As Integer
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("Sheet1") 'Change this to: Set ws = Sheets("Master Sheet")
For Row = 3 To 5
Set rng = ws.Range("B3:AS3").Offset(Row, 0) 'Change to (I'm guessing here): ws.Range("$J$7:$Y$7").Offset(Row, 0)
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(ws.Name & "!" & rng.Address)
ActiveChart.ChartType = xlLineMarkers
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection(1).XValues = "='Sheet1'!$B$1:$AS$1" 'Change to "='Master Sheet'!$J$2:$Y$2"
ActiveChart.SeriesCollection(1).Name = ws.Range("A1").Offset(Row, 0).Value 'Change this to whatever you want to name the graphs. This is currently set to dynamicly name each graph by the series name set in Column A.
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=ws.Range("A1").Offset(Row, 0).Value 'uncomment this line to put on new sheet
With ActiveChart
.HasLegend = False
.SeriesCollection(1).Trendlines.Add(Type:=xlMovingAvg, Period:=12).Select
'.Axes(xlCategory).TickMarkSpacing = 6
.Axes(xlCategory).HasMajorGridlines = True
End With
With ActiveChart.SeriesCollection(1).Trendlines(1)
.Border.ColorIndex = 33
.Border.Weight = xlMedium
.Border.LineStyle = xlDashDotDot
End With
ws.Select 'Need to go back to worksheet
Next Row
Set ws = Nothing
Set rng = Nothing
End Sub
Sample Data:
Apr-10 May-10 Jun-10 Jul-10 Aug-10 Sep-10 Oct-10 Nov-10 Dec-10 Jan-11 Feb-11 Mar-11 Apr-11 May-11 Jun-11 Jul-11 Aug-11 Sep-11 Oct-11 Nov-11 Dec-11 Jan-12 Feb-12 Mar-12 Apr-12 May-12 Jun-12 Jul-12 Aug-12 Sep-12 Oct-12 Nov-12 Dec-12 Jan-13 Feb-13 Mar-13 Apr-13 May-13 Jun-13 Jul-13 Aug-13 Sep-13 Oct-13 Nov-13
Company 1 14666 12795 10874 12560 13098 12660 14618 14031 14654 13016 11012 13912 14038 12262 12997 11295 12899 12878 14922 10493 13714 11513 12385 10528 13025 11637 11856 14794 10874 13286 12393 10164 11660 14948 13325 12689 14623 10368 10476 10386 11751 13766 11134 10497
Company 2 11769 10449 10835 12071 14354 12432 13698 14426 11763 11685 14876 12118 10110 12837 10144 10169 12664 11393 12613 13239 13681 14312 10848 14293 11270 14623 13738 12481 12226 11837 13960 12567 11668 12646 10829 11439 13698 10678 11409 13652 11056 13503 13182 14675
Company 3 13181 11246 11815 14960 11481 10863 10259 12287 13468 10454 12553 14751 10559 13592 14844 10799 11323 13218 13711 12547 14410 14205 10713 13059 12439 14185 11543 11537 11848 11150 12130 14641 13330 12934 12037 14982 11709 10971 13810 10729 13842 14457 14361 13281
Company 4 12223 13097 12032 10047 13361 12067 14420 11880 12270 10718 12367 12327 12542 13593 14858 14567 10096 10166 10580 13860 14581 12268 11613 11423 10472 13811 10801 13333 10324 12594 12745 12127 10944 10979 14404 14943 11067 12009 14457 10598 13409 13781 11553 13000
Company 5 13680 14319 13858 14356 13666 11855 11495 11406 14980 11369 10108 13726 11543 11311 12884 14486 10538 11346 14347 13568 14763 10218 14278 13355 13286 11899 13436 13980 14459 13648 14930 14999 12706 14181 11793 12777 14802 11914 10000 11245 13331 10915 11646 10435
Company 6 10083 10355 12951 13342 11059 13582 11118 14696 10608 11010 13741 13970 11800 13850 12179 13557 14757 13859 13297 14772 13896 11726 13055 13703 10883 11561 12175 13169 12040 10099 11165 12276 11627 12743 12092 12465 10375 10382 11125 14841 13409 12030 13165 12947
Company 7 12146 13011 14596 13182 13859 14605 13945 13826 14808 10528 12939 12123 12995 10259 12733 12132 13464 10246 11535 10440 14336 10856 10514 14316 13434 10513 10310 13833 13510 13442 11008 14883 12794 14255 13858 14184 10891 10429 14478 14679 13519 10498 10731 12438
Company 8 14815 13134 11152 13517 14849 12229 12884 10379 11917 11030 14059 10568 10975 14141 12078 12463 10602 12129 13460 10327 12262 11740 11278 13873 12184 13846 13275 10480 13078 13244 12005 12734 11160 14214 14511 14042 12153 12066 14280 11756 10621 13704 14137 13754
Company 9 14484 10161 14949 11218 14022 13369 11816 14573 14007 14962 13764 10730 14864 13414 11457 13405 10155 13868 13413 11129 12582 11212 13365 11107 13251 13103 12726 12545 14518 12512 12531 10677 12821 10819 10632 11638 12649 11437 10981 12661 11761 13174 13753 12176
Company 10 12523 14590 12610 10071 10965 14594 11908 14258 13927 10058 10496 11185 14372 12343 14455 11573 10534 10864 10814 12513 14356 10763 11413 10717 12409 14452 12473 11120 14296 12602 12950 12613 13964 14978 10129 13718 14289 13837 14312 12038 10796 10430 12051 11567
After changing the script to this:
The script doesnt get a new line everytime it runs and the 2nd graph it makes on a new page just piles the rest of the graphs on top of them!
Starting to loose my mind! :(
Sub test()
Dim Row As Long
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("Sheet1")
For Row = 3 To 4
Set rng = ws.Range("B3:AS3")
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
.SetSourceData Source:=Range(ws.Name & "!" & rng.Address)
.ChartType = xlLineMarkers
.PlotArea.Select
.SeriesCollection(1).XValues = "='Sheet1'!$A2:$AS2"
.SeriesCollection(1).Name = ws.Range("A1")
.HasLegend = False
.SeriesCollection(1).Trendlines.Add(Type:=xlMovingAvg, Period:=12).Select
.Axes(xlCategory).HasMajorGridlines = True
With .SeriesCollection(1).Trendlines(1)
.Border.ColorIndex = 33
.Border.Weight = xlMedium
.Border.LineStyle = xlDashDotDot
End With
End With
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=ws.Range("A1").Offset(Row, 0).Value
Next Row
Set rng = Nothing
Set ws = Nothing
End Sub
回答1:
This is my version of what you want:
Tried and Tested using your workbook
Option Explicit
Sub test()
Dim ws As Worksheet
Dim ch As Chart
Dim trend As Trendline
Dim rng As Range
Dim i As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
Set rng = ws.Range("$A$3:$AS$3")
For i = 0 To 39
With ws
Set ch = .Shapes.AddChart.Chart.Location(xlLocationAsNewSheet, .Range("A3").Offset(i, 0))
ch.ChartType = xlLineMarkers
ch.SetSourceData Source:=Range(.Name & "!" & rng.Offset(i, 0).Address)
ch.SeriesCollection(1).XValues = "=Sheet1!$B$2:$AS$2"
Set trend = ch.SeriesCollection(1).Trendlines.Add(xlMovingAvg, 12)
With trend.Border
.ColorIndex = 33
.Weight = xlMedium
.LineStyle = xlDashDotDot
End With
Set ch = Nothing
Set trend = Nothing
End With
Next
Set rng = Nothing
Set ws = Nothing
End Sub
I stick with using Offset and declared most of the chart objects.
Hope this helps a bit.
See screen shots of sample graphs using your recently uploaded chart.
Company1 which is the first set of data in your sample data:
Company3 with first few columns zero:
Company40 with last few columns zero:
来源：https://stackoverflow.com/questions/20649289/create-a-new-chart-for-each-row-using-vba-macros-in-excel