Supportnet / Forum / Tabellenkalkulation
VBA Code verbessern
Frage
Hi Leute!
Mein Makro wählt leider erst die Daten ab Spalte K für die Grafik aus. Er sollte aber die Daten ab Spalte B in Archiv_Spread auswählen. Vielleicht kann mir wer sagen wo der Fehler im Makro liegen kann?
Sub test()
Dim Name As Worksheet
Dim Bereich As String
Dim Bereich1 As String
Dim Bereich2 As String
Dim n As String
Dim n2 As String
Dim i As Integer
Dim y As Integer
Dim Startzeile As Integer
Dim Endspalte As Integer
On Error GoTo fehler
Set Name = ThisWorkbook.Sheets("Archiv_Spread")
i = 1
y = 2
Do While Name.Cells(i, 1).Value = ""
i = i + 1
Loop
If Val(Name.Cells(i, 1).Value) <> 0 Then
MsgBox "Kein Name gefunden", vbOKOnly, "Fehler"
Exit Sub
End If
Startzeile = i
n = Name.Cells(i, 1).Value
For j = 1 To ActiveWorkbook.Sheets.Count Step 1
If InStr(ActiveWorkbook.Sheets(j).Name, n) > 0 Then
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(j).Delete
Application.DisplayAlerts = True
End If
Next j
i = i + 1
Do While Val(Name.Cells(i, 1).Value) <> 0 And Name.Cells(i, 1).Value <> ""
Do While Name.Cells(i, y).Value <> ""
y = y + 1
Loop
Endspalte = y - 1
Bereich1 = Cells2Range(Startzeile, 2) & ":" & Cells2Range(Startzeile, Endspalte)
Bereich2 = Cells2Range(i, 2) & ":" & Cells2Range(i, Endspalte)
Bereich = Bereich1 & "," & Bereich2
n2 = n & " " & Name.Cells(i, 1).Value
Diagramm Name, Bereich, n2
i = i + 1
Loop
Sheets("sheet2").Select
Sheets("sheet2").Move after:=Sheets("Archiv_Spread")
Sheets("sheet3").Select
Sheets("sheet3").Move after:=Sheets("sheet2")
Sheets("Name 1").Select
Sheets("Name 1").Move after:=Sheets("Tabelle3")
Worksheets("Archiv_Spread").Activate
Exit Sub
fehler:
If Err.Number = 9 Then
Resume Next
End If
End Sub
Sub Diagramm(ByVal Name As Worksheet, B$, Names$)
Dim c As Integer
On Error GoTo error1
c = ActiveWorkbook.Sheets.Count
Charts.Add , ActiveWorkbook.Sheets(c)
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Name.Range(B), PlotBy _
:=xlRows
ActiveChart.SeriesCollection(1).Name = Names
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=Names
With ActiveChart
´.HasTitle = True
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Datum"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Wert"
End With
With ActiveChart
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = True
Active.Chart.Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
End With
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
ActiveChart.HasLegend = False
ActiveChart.HasDataTable = False
ActiveChart.ChartTitle.Select
Selection.AutoScaleFont = True
ActiveChart.ChartTitle.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
ActiveChart.ChartArea.Select
Sheets(c).Select
Sheets(c).Move Before:=Sheets(c)
Exit Sub
error1:
If Err.Number = 9 Then
Resume Next
End If
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
´MsgBox "Kann Tabellenblatt nicht anlegen", vbOKOnly, "Fehler"
End Sub
Function Cells2Range(Zeile As Integer, Spalte As Integer)
Dim spalte2$
spalte2 = Columns(Spalte).Address(False, False)
spalte2 = Left(spalte2, InStr(spalte2, ":") - 1)
Cells2Range = spalte2 & Zeile
End Function
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
End Sub
Private Sub Start_Click()
test
End Sub
Danke im Voraus
AF
Antwort 1 von Beverly
Hi AF,
bist du den Code mal im Einzelschrittmodus durchgegangen und hast die Variablen geprüft? Der Code ist ziemlich lang, und ohne zu wissen wo genau und welche Daten sich befinden, kann man ihn schlecht nachvollziehen.
Bis später,
Karin
bist du den Code mal im Einzelschrittmodus durchgegangen und hast die Variablen geprüft? Der Code ist ziemlich lang, und ohne zu wissen wo genau und welche Daten sich befinden, kann man ihn schlecht nachvollziehen.
Bis später,
Karin