Hallo,
ich möchte ein Script erstellen um ein Diagramm zu erstellen.
Die Zellen mit denen die Säulen erstellt werden sollen, liegen
alle in einer Zeile.
Der Name liegt in Zelle A2 und der dazugehörige Wert in B2.
Die nächste Säule soll direkt neben der ersten als Vergleichswert liegen.
Der Name dieser Säule liegt in Zelle D2 und der Wert in E2.
Die Tabelle hänge ich an.
Hat mir jemand einen Tip.
Danke und Gruß
Günti
Hallo,
ich habe die Lösung für dieses Problem gefunden.
Aber wie kann ich auf Tabelle 2 nach jeder zweiten Zeile eine Leerzeile einfügen ?
Danke im voraus und Gruß
Günti
Code:
Sub prcForm_Excel_Dateien_einlesen()
Dim lngC As Long, lngA As Long
Dim strPath As String
Dim strDatei As String
Dim vntZellAdressen As Variant
Dim LastRow As Long
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim Rng4 As Range
Dim ShName As String
lngC = 1
vntZellAdressen = Array("A2", "B2", "A3", "B3")
strPath = "C:\PG500\Inf-Files\"
strDatei = Dir(strPath & "*.xlsx")
Do While strDatei <> ""
Workbooks.Open (strPath & strDatei)
For lngA = 0 To UBound(vntZellAdressen)
ActiveWorkbook.Worksheets(3).Range(vntZellAdressen(lngA)).Copy ThisWorkbook.Worksheets(1).Cells(lngC, lngA + 1)
Next lngA
lngC = lngC + 1
ActiveWorkbook.Close False
strDatei = Dir
Loop
'Erste Zeile einfügen
Rows(r + 1).Insert Shift:=xlDown
'Spalten beschriften
Range("A1").Select
ActiveCell.FormulaR1C1 = "Prüfauftrag Monat A"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Yield Monat A in %"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Prüfauftrag Monat B"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Yield Monat B in %"
'Anpassung der Spaltenbreite
Call ActiveSheet.Columns.AutoFit
'Arbeitsblatt umbenennen
ThisWorkbook.Worksheets(1).Name = "Yieldauswertung"
'Auflistung der Prüfmonate
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim lngZ As Long
Dim lngZZ As Long
Dim intS As Integer
Set wksQ = Worksheets(1) 'Quellblatt
Set wksZ = Worksheets(2) 'Zielblatt
lngZZ = 2
With wksQ
For lngZ = 2 To .Range("A100").End(xlUp).Row
wksZ.Cells(lngZZ, 1).Value = wksQ.Cells(lngZ, 1).Value
wksZ.Cells(lngZZ, 2).Value = wksQ.Cells(lngZ, 2).Value
lngZZ = lngZZ + 1
wksZ.Cells(lngZZ, 1).Value = wksQ.Cells(lngZ, 3).Value
wksZ.Cells(lngZZ, 2).Value = wksQ.Cells(lngZ, 4).Value
lngZZ = lngZZ + 1
Next
End With
'Auf Tabelle2 (Blatt2) wechseln
Sheets("Tabelle2").Activate
'Zahlenformat festlegen
Range("B1:B300").NumberFormat = "#,##0.00"
'Letzte Zeile suchen und Diagrammbereich in Variable schreiben
With ActiveSheet
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set Rng1 = .Range("A2:B" & LastRow)
ShName = .Name
End With
'Diagramm einfügen
Charts.Add
With ActiveChart
.ChartType = xlColumnClustered
.SetSourceData Source:=Rng1
'Beschriftung Diagramm
'.HasTitle = True
.SetElement (msoElementChartTitleAboveChart)
.ChartTitle.Text = "Yieldauswertung"
.Location Where:=xlLocationAsObject, Name:=ShName
End With
With ActiveChart.Parent
.Left = 400
.Top = 50
.Width = 400
.Height = 300
End With
'Arbeitsblatt umbenennen
ThisWorkbook.Worksheets(1).Name = "Yieldauswertung"
End Sub