Erstellen Sie eine neue Tabelle für jede Zeile verwenden von VBA-Makros in Excel

In Erster Linie lassen Sie mich nur sagen, diese website ist ein Geschenk des Himmels!

Ich habe einen Datenbereich B2:AS40 für jeden Monat. Der Monat in A2:AS2, in A2:A40 ist eine Liste mit Namen, all dies ist in 'Tabelle1'

Nach einigen vorherigen suchen hier habe ich kommen mit dem folgenden, das Skript erstellt eine neue Tabelle für jede Zeile erstellt einen Titel und legt die MajorGridlines bei 6mth Abständen, jedoch nicht plot der Daten. Ich kann nicht für das Leben von mir herauszufinden, warum!!

Bitte helfen

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

Beispieldaten:

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

Nach der änderung das script:

Das Skript nicht eine neue Zeile jedesmal, wenn es läuft und die 2. Grafik macht es auf einer neuen Seite nur ein Haufen, der rest des Graphen auf Sie!

Beginnend zu verlieren, meine Meinung! 🙁

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

Einige Kontext, in dem meine Fortschritte kamen von hier: stackoverflow.com/questions/12905087/...
Können Sie ein Beispiel für Ihre Daten?
BTW ich getestet, der code auf sample-Daten, und es funktioniert Prima. Jetzt muss ich sehen, Ihre sample-Daten
Ich habe platziert oben aufgeführten Beispieldaten 🙂
Ich bin schon posting eine Antwort mit einem smaple Daten, die ich erstellt 😛

InformationsquelleAutor DaleW | 2013-12-18

1

Dies ist meine version von dem, was Sie wollen:

Versucht und Getestet, mit Ihrer Arbeitsmappe
```
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
```
Ich stick mit die Verwendung von Offset und erklärt die meisten der Diagramm-Objekte.

Hoffe, das hilft ein bisschen.

Siehe screenshots von Beispiel-Graphen mit den gerade hochgeladenen Diagramm.

Weltweit1 das ist der erste Satz von Daten in Ihrer Probe-Daten:

Company3 mit den ersten paar Spalten null:

Company40 mit letzten Spalten null:

Eigentlich ist der offset ist gar nicht erforderlich 🙂
ja, ich war beim Lesen durch Ihre code und wondrin haha 🙂 aber ich werde Sie führen die OP-code-arbeiten mit wechselnden oben.
Wird diese Arbeit, wenn die ersten paar Spalten r bank?
Habe es getestet und es funktioniert sogar, wenn die ganze Zeile leer ist oder die ersten paar Spalten sind leer. aber nur Sie können sagen, wenn der resultierende graph dient Ihren Zweck. Ich habe den screenshots einige graph-Muster mit deiner kürzlich hochgeladenen Datei.
Ich weiß wirklich zu schätzen Ihre Hilfe, im jedoch noch immer ein Fehler - its driving me mad! Ich kann nicht verstehen, warum es für Sie arbeitet, aber nicht mich!!!!! Ich habe zwei screenshots, um sicherzustellen, dass wir auf der exakt gleichen Seite. Vielen Dank für Ihre Hilfe! Link1: wikisend.com/download/112454/Shot2.png Link2:wikisend.com/download/744410/Shot1.png

InformationsquelleAutor L42

Schreibe einen Kommentar

Du musst angemeldet sein, um einen Kommentar abzugeben.