VBA 2 Sheets in 2 PDF's mit Auswahl

Ich muss dich allerdings warnen. Ich arbeite noch nicht lange mit VBA. Falls es also nicht ganz sooo übersichtlich ist, man gewisse Stellen vereinfachen könnte etc. einfach darüber hinwegsehen.



Hier der Code:



Sub Grafiken()



Application.ScreenUpdating = False

Rem: Defintion Variabeln

Dim station As String



Dim legend As String

Dim titel As String



Dim legendm As String

Dim titelm As String

Dim okt As String

Dim dez As String

Dim feb As String

Dim apr As String

Dim k As Integer

Dim winter As String

Dim posTop As Integer



Dim xWerte As Range, yWerte As Range

Rem: Variabeln zum Definieren des benutzten Bereichs

Dim lastRow As Integer, lastColumn As Integer, anzahlSpalten As Integer



Dim kanton As Boolean '/ Variable zur Bestimmung ob Graphik Entwicklung pro Tiefe gemacht werden soll oder nicht

Dim Scatter As Boolean '/ Variable zur Bestimmung ob Graphik pro Monat Scatter ist oder nicht



Dim minScale As Double, maxScale As Double '/ Zum Skalieren der xAchse

Rem: Löschen aller alten Graphiken, sicherheitshalber...

Call grafiken_nach_quelle.grafiken_loeschen("Grafiken_Station_alle_VBA")



Rem: Facts pro Station

station = Sheets("Grafiken_Station_alle_VBA").Cells(2, 2)

Call facts_pro_station.facts_pro_station(station, "Grafiken_Station_alle_VBA", 4, 1)



Rem: Kopieren der entsprechenden Auswahl aus der Pivottabelle in die Hilfstabelle "Auswahl nicht als Pivot

Call kopieren_auswahl(station)



Rem: Graphik Profile alle

With Sheets("Auswahl nicht als Pivot")

lastRow = .Range("A65536").End(xlUp).Row

lastColumn = .Range("IV" & 5).End(xlToLeft).Column

End With

Rem: Erstellen der Graphik

Sheets("Grafiken_Station_alle_VBA").Activate

Sheets("Grafiken_Station_alle_VBA").Shapes.AddChart.Select

With Sheets("Auswahl nicht als Pivot")

Rem: Bestimmen des Diagrammtyps (Punkte, Linie, Linie & Punkte)

If Application.WorksheetFunction.CountA(.Range(.Cells(5, 1), .Cells(lastRow, 1))) = 1 Then

Scatter = True

ActiveChart.ChartType = xlXYScatter

Else

ActiveChart.ChartType = xlXYScatterSmoothNoMarkers

End If

For i = 2 To lastColumn

If Application.WorksheetFunction.CountA(.Range(.Cells(5, i), .Cells(lastRow, i))) = 1 Then

ActiveChart.ChartType = xlXYScatterSmooth

Exit For

End If

Next i

End With

With ActiveChart



For i = 2 To lastColumn

Rem: Graphik

legendm = Sheets("Auswahl nicht als Pivot").Cells(5, i).Value

.SeriesCollection.NewSeries

.SeriesCollection(i - 1).Name = legendm

Set xWerte = Sheets("Auswahl nicht als Pivot").Cells(7, i)

Set yWerte = Sheets("Auswahl nicht als Pivot").Cells(7, 1)

For j = 8 To lastRow

If Sheets("Auswahl nicht als Pivot").Cells(j, i) <> "" Then

Set xWerte = Union(xWerte, Sheets("Auswahl nicht als Pivot").Cells(j, i))

Set yWerte = Union(yWerte, Sheets("Auswahl nicht als Pivot").Cells(j, 1))

End If

Next j

.SeriesCollection(i - 1).XValues = xWerte

.SeriesCollection(i - 1).Values = yWerte

Next i



If Sheets("Grafiken_Station_alle_VBA").Cells(4, 2) = "x" And Sheets("Grafiken_Station_alle_VBA").Cells(3, 2) = "" And _

Sheets("Grafiken_Station_alle_VBA").Cells(5, 2) = "" Then .SeriesCollection(lastColumn).Delete

Rem: Formatieren der Graphik

.Axes(xlValue, xlPrimary).HasTitle = True

.Axes(xlValue, xlPrimary).AxisTitle.Text = "Tiefe [m]"

.Axes(xlCategory, xlPrimary).HasTitle = True

.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Temperatur [°C]"



.HasTitle = True



titel = "Profile Station " & station

.ChartTitle.Text = titel '<<<<< HIER KOMMT DIE FEHLERMELDUNG, OBWOHL 2 ZEILEN WEITER OBEN .HasTitle= True steht !?!



minScale = Application.WorksheetFunction.min(Sheets("Auswahl nicht als Pivot").Range(Sheets("Auswahl nicht als Pivot").Cells(7, 2), Sheets("Auswahl nicht als Pivot").Cells(lastRow, lastColumn))) - 0.5

.Axes(xlCategory).MinimumScale = minScale

maxScale = Application.WorksheetFunction.max(Sheets("Auswahl nicht als Pivot").Range(Sheets("Auswahl nicht als Pivot").Cells(7, 2), Sheets("Auswahl nicht als Pivot").Cells(lastRow, lastColumn))) + 0.5

.Axes(xlCategory).MaximumScale = maxScale



Rem: Positionieren der Graphik

.Parent.Left = 200

.Parent.Top = 60



End With

Rem: Schauen ob es eine "kantonale" Station ist

With Sheets("Grafiken_Station_Alle_Vba")

If .Cells(3, 2) = "x" Then kanton = True

End With



Rem: Graphik Entwicklung pro Tiefe

If kanton = True Then

Call Entwicklung_pro_Tiefe(lastRow, lastColumn)

Rem: Graphik Profile nach Monat

Call Profil_Monat("10", anzahlSpalten, lastRow, lastColumn, station, Scatter) 'Oktober

Call Profil_Monat("12", anzahlSpalten, lastRow, lastColumn, station, Scatter) 'Dezember

Call Profil_Monat("02", anzahlSpalten, lastRow, lastColumn, station, Scatter) 'Februar

Call Profil_Monat("04", anzahlSpalten, lastRow, lastColumn, station, Scatter) 'April

End If

End Sub

Hallo,



wenn du das "No" in einer Formel eintragen willst, wird es in der Formel mit Anführungszeichen geschrieben. Deswegen muss es dann in VBA mit 2 Anführungzeichen geschrieben werden. Bei der Worksheetfunction fragst du nur den String "No" ab und da reichen
dann einfache Anführungszeichen.

Probiers mal so:

Lrow48 = Sheets("Raw Data 48hrs").Cells(Rows.Count, 2).End(xlUp).Row

With Sheets("FP")

lrowfp = .Cells(.Rows.Count, 2).End(xlUp).Row

For Each rngfp In .Range("D3" & lrowfp)

rngfp.Value = WorksheetFunction.CountIfs(Sheets("Raw data 48hrs") _

.Range("A2:A" & Lrow48), .Cells(rngfp.Row, 2), _

Sheets("Raw Data 48hrs").Range("M2:M" & Lrow48), "No")

Next

End With



Den Bezug, in den die Formel soll:

sheets("Test").range("B1:B" & Lrow).formula="=(...)





Mit freundlichen Grüßen

Claus

Vielen Dank für die Antwort-

Ja, Windows 10. Die Datei ist zu umfangreich. Ich habe das Problem mit einem einfachen Beispiel illustriert.

Codeausschnitt:

Sub TestRH()

Dim k As Integer, l As Integer

Dim a As Double

'Sheets("Arbeitsblatt").Activate

Sheets("Arbeitsblatt").Activate

With Sheets("Arbeitsblatt")

For l = 1 To 60

For k = 1 To 10

.Cells(k, 1) = k

.Cells(k, 2) = k * l + l

Next k

Diag

'Sheets("Diagramm").Activate

Next l

End With

End Sub

Private Sub Diag()

Sheets("Diagramm").Visible = True

Sheets("Diagramm").Activate

Sheets("Diagramm").Select

End Sub

Es sind 2 Blätter relevant, im"Arbeitsblatt" werden die Werte eingetragen, die im Sheet "Diagramm" als Quelldaten des Diagramms genutzt werden. Auch wenn man die erste For -Schleife ändert-es sind im Diagramm stets die Werte des letzten Durchgangs zu sehen
(VBA-zu schnell für die Darstellung aller Zwischenwerte). Ich brauche eine zeitlich vorgegebene vba-Unterbrechung bei jedem Schl.-Durchgang.

Manuell habe ich im Debugger einen Haltepunkt gesetzt. Wie kann ich das programmieren? Vielen Dank im voraus!

Vielleicht hast Du Namen in der Tabelle stehen die keiner Tabelle entsprechen?

Oder keine Daten in einer der Tabellen?

Oder eine der Tabellen ist unsichtbar?

Oder...



Mach mal eine neue Datei mit mindestens 2 Tabellen und führe dies Makro aus:



Sub Test()

Sheets(1).Range("A1") = 1

Sheets(2).Range("A1") = 2

Sheets(Array(Sheets(1).Name, Sheets(2).Name)).PrintPreview

End Sub

Geht einwandfrei, oder?



Andreas.

Habe das Problem gelöst.

Vorab vielen Dank für Eure Mühe.

Hatte eine Mappe in der ich zu einem Sheet Bezüge in 4 anderen Sheets in Form von Übernahme reiner Zahlen hergestellt habe.

Wenn ich die Zahlen im ersten Sheet änderte durch einkopieren einer Zahlenkolonne, änderten sich die Daten und Auswertungen entsprechend in den anderen Sheets.

Dann habe ich mit neuen Ideen zur Auswertung mit "Speichern unter" weitere verschiedene Mappen eröffnet, dabei blieb das Ausgangssheet aber immer gleich und das zugehörige Macro für das Einfügen neuer Datenreihen auch.

Hiermit habe ich offensichtlich VBA intern an seine Grenzen gebracht da wohl die Bezüge zu den ca. 10 Mappen erhalten wurden in denen immer dieses eine Sheet vorhanden war.

Folge Bearbeitung des Macros nicht möglich. Fehlermeldungen für den Speicher innerhalb VBA Abstürze Wiederherstellungen.

Ich habe dann als erstes das Ausgangssheet in den 2 Mappen die ich aktuell brauche vom Namen her geändert, bzw. in ein neues Sheet den Inhalt kopiert und das Alte gelöscht.Die anderen 8 Mappen, da sie keine Bedeutung mehr hatten gelöscht.

Danach funktioniert es wieder.

Um es deutlich zu machen: Der Bezug von Sheet zu Sheet war in der Zelle A1 = SheetxyA1

keine Formel nur das übertragen einer Zahl.

Man kann VBA wohl auch mit so einfachen Bezügen überlasten.

Gruß

Dieter