Ich habe eine Frage zum automatischen Erstellen von Plots (Diagrammen) mit VBA-Code. Ich kann ein Excel-Dokument mit zwei Arten von Spalten haben: Spalten, die in 6 gruppiert werden können, oder Spalten, die in 7 gruppiert werden können. Die ersten 2 Bilder zeigen, wie ich das Excel-Dokument erhalte.
Was ich tun muss, ist:
Schritt 1. Kopieren Sie Spalte A und stellen Sie sie vor jede Gruppe von 6 oder 7 Spalten. Fügen Sie auch eine leere Spalte wie in Bild 3 ein.
Schritt 2. zum Erstellen eines Diagramms für jede neue Gruppe, die in einem neuen Blatt erstellt wurde (wenn ich beispielsweise 100 Gruppen von Spalten habe, möchte ich 100 Diagramme haben. Jedes Diagramm auf einem einzelnen Blatt)
Die Frage lautet: Wie wird jedes Diagramm in getrennte Blätter eingefügt?
Bei Bedarf lautet der Name des ersten Blattes "HOOD"
Der von mir geschriebene Code kann Schritt 1 ausführen und erstellt auch Diagramme. Das Problem ist jedoch, dass ich nicht jedes Diagramm auf ein einzelnes Blatt setzen kann.
Ich kann Schritt 1 ausführen und ab Schritt 2 kann ich nur die Diagramme erstellen, aber ich kann nicht jedes Diagramm in ein neues Blatt einfügen.
Sub Macro_Linearity_Plot()
Dim pas As Integer
Dim val As Integer
Dim lCol As Integer
Dim i As Integer
Dim uCol As Integer
' define the numbers of columns. it can be 6 or 7 columns.
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
val = Range("A1").Value
pas = val + 2
' insert 2 new empty columns
For colx = pas To lCol Step pas
Columns(colx).Insert Shift:=xlToRight
Columns(colx).Insert Shift:=xlToRight
Next
' insert column number 1
For colx = pas + 1 To lCol Step pas
Sheets("HOOD").Columns(1).Copy
Sheets("HOOD").Columns(colx).PasteSpecial xlPasteValues
Next
' for every group of columns created at the last step generate a chart
uCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = -1 To uCol Step pas
Range(Cells(2, i + 2), Cells(121, i + pas)).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(Cells(2, i + 2), Cells(121, i + pas))
ActiveChart.ChartType = xl3DArea
Next
End Sub
Vielen Dank :)
AKTUALISIERT
Der neue Code lautet:
Sub Macro_Linearity_Plot()
Dim pas As Integer
Dim val As Integer
Dim lCol As Integer
Dim i As Integer
Dim uCol As Integer
' define the numbers of columns. it can be 6 or 7 columns.
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
val = Range("A1").Value
pas = val + 2
' insert 2 new empty columns
For colx = pas To lCol Step pas
Columns(colx).Insert Shift:=xlToRight
Columns(colx).Insert Shift:=xlToRight
Next
' insert column number 1
For colx = pas + 1 To lCol Step pas
Sheets("HOOD").Columns(1).Copy
Sheets("HOOD").Columns(colx).PasteSpecial xlPasteValues
Next
' for every group of columns created at the last step generate a chart
uCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = -1 To uCol Step pas
Range(Cells(2, i + 2), Cells(121, i + pas)).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(Cells(2, i + 2), Cells(121, i + pas))
ActiveChart.ChartType = xl3DArea
xx = 1 'Just to identify the Graph order
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Chart" & xx
'Count the sheets and Charts for moving Chart to the end
ws = ThisWorkbook.Worksheets.Count
cht = ThisWorkbook.Charts.Count
Sheets("Chart" & xx).Move After:=Sheets(ws + cht)
xx = xx + 1
Next
End Sub
Es gibt jedoch einige Fehler:
2 Antworten
Das aufgetretene Problem ist typisch, wenn Sie mit nicht qualifizierten Bereichen arbeiten. Nicht qualifizierte Bereiche beziehen sich auf das aktive Arbeitsblatt, das sich jedes Mal ändert, wenn Sie ein neues Arbeitsblatt einfügen, sodass Ihr Code nach der ersten Schleife durcheinander gerät.
Zuerst hatte ich Ihren Code durch "Reaktivieren" des Blattes HOOD nach jeder Schleife korrigiert, aber ich zog es vor, Ihren Code komplett neu zu schreiben, damit er sich zusätzlich nie auf nicht qualifizierte Bereiche bezieht zu ein paar anderen Korrekturen.
Sub Macro_Linearity_Plot()
Dim pas As Integer, val As Integer, lCol As Integer, i As Integer, ch As Chart
With Sheets("HOOD")
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
val = .Range("A1").Value
pas = val + 2
' insert an empty column and a copy of column A
For colx = pas To lCol Step pas
.Columns(colx).Insert Shift:=xlToRight
.Columns(colx).Insert Shift:=xlToRight
.Columns(1).copy .Columns(colx + 1)
Next
Application.CutCopyMode = False
' for every group of columns generate a chart and move it to end of Workbook
lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For i = -1 To lCol Step pas
Set ch = ActiveWorkbook.Charts.Add '<~~ add a chart in own new sheet
ch.ChartType = xl3DArea
ch.SetSourceData .Range(.Cells(2, i + 2), .Cells(121, i + pas))
ch.name = "Chart" & CInt(1 + (i + 2) / pas)
ch.Move , ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
Next
End With
End Sub
Ich habe einige Elemente in Ihrem ursprünglichen Skript überprüft und geändert.
Mein schlechtes bei der Einstellung des Anfangs xx, es muss vor der Schleife sein, sonst wird es immer 1 sein.
Einige Änderungen, die ich vorgenommen habe, und ich bin sicher, dass es auch bessere Möglichkeiten gibt: Die Zuordnung der letzten Spalte; Stellen Sie sicher, dass Sie sich auf das spezifische Blatt beziehen, für das Sie eine Gruppe von Zellen usw. auswählen möchten.
Sub Macro_Linearity_Plot()
Dim pas As Integer
Dim val As Integer
Dim lCol As Integer
Dim i As Integer
Dim uCol As Integer
' define the numbers of columns. it can be 6 or 7 columns.
'You lCol script was worn got determine the last Column
With ActiveSheet.UsedRange
lCol = .Columns(.Columns.Count).Column
End With
'lCol = Cells(1, Columns.Count).End(xlToLeft).Column
val = Range("A1").Value
pas = val + 2
' insert 2 new empty columns
For colx = pas To lCol Step pas
Sheets("HOOD").Columns(colx).Insert Shift:=xlToRight
Sheets("HOOD").Columns(colx).Insert Shift:=xlToRight
Next
' insert column number 1
For colx = pas + 1 To lCol Step pas
Sheets("HOOD").Columns(1).Copy
Sheets("HOOD").Columns(colx).PasteSpecial xlPasteValues
Next
' for every group of columns created at the last step generate a chart
uCol = Cells(1, Columns.Count).End(xlToLeft).Column
xx = 1 'Just to identify the Graph order
For i = -1 To uCol Step pas
'Need top reselect the "HOOD" sheet for the range selection
ActiveWorkbook.Sheets("HOOD").Select
Sheets("HOOD").Range(Cells(2, i + 2), Cells(121, i + pas)).Select
ActiveWorkbook.Sheets("HOOD").Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(Cells(2, i + 2), Cells(121, i + pas))
ActiveChart.ChartType = xl3DArea
ChartName = "Graph Group " & xx
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=ChartName
'Count the sheets and Charts for moving Chart to the end
ws = ThisWorkbook.Worksheets.Count
cht = ThisWorkbook.Charts.Count
Sheets(ChartName).Move After:=Sheets(ws + cht)
xx = xx + 1
Next i
End Sub