Makro anpassen zum Daten einlesen
31.07.2016 17:38:58
Burkhard
Ich habe mir mal wieder eine Aufgabe gestellt, leider werde ich dieser Idee nicht ganz Herr :-(
Ich habe bereits eine sehr gut laufende Auswertung, welche ich noch erweitern möchte.
aber leider übersteigt das Makro deutlich meine Fähigkeiten, ich kann es leider nicht allein anpassen. Kleine möglich Änderungen habe ich bereits vorgenommen, aber die eigentlichen Daten bekomme ich nicht rein!!
Es stellt sich folgendermaßen dar.
Ich habe eine Produktivitätsauswertung für eine ganze Woche, diese Datei ist an einem anderen Ort immer gespeichert. das Tabellenblatt (Schichteingabe) hierzu hänge ich mit an. Unter dem jeweiligen Tag ab Zeile 31 schreibe ich nun Ausfallparameter.
Diese will ich nun ebenfalls in meine Auswertungsdatei einlesen in ein separates Tabellenblatt (Ausfallzeiten) Zusätzlich möchte ich aber auch jede eingelesene Zeile mit dem Jeweiligen Jahr/ TAG/Woche beschriften. Diese Daten sind in der Tabelle auch Vorhanden. Für mich war immer das Hauptproblem, das ich keine feste Anzahl an Werten habe, mal können es 5 Datensätze sein und am nächsten Tag 25 Datensätze!
Ich hoffe ihr könnt mir dabei helfen, das Makro anzupassen.
Ich hänge eine Beispieldatei an, bitte daran denken, das dass Tabellenblatt "Schichteingabe" in einer neuen Datei an einem anderen Ort gespeichert wird, der Ort wird oben im Makro eingegeben.
https://www.herber.de/bbs/user/107335.xlsx
Bei Fragen bitte melden, glaube ich konnte das Problem nicht so gut rüberbringen, aber in Zusammenarbeit können wir das bestimmt gut lösen!!!
Danke und Grüße
Burkhard
Anbei das Makro,
Ich Versuche beide Makros nochmal als Textdatei anzuhängen.
1. das Makro zum einlesen der Ausfallzeiten
2. das Makro, zum einlesen der Produktionsdaten, diesen läuft bereits
https://www.herber.de/bbs/user/107336.txt
Option Explicit
'Private Const cstrPath = "K:\TFDE_OPS\PUBLIC\Production Control SHO\Servicemeeting\Produktivität\"
Private Const cstrPath = "C:\Users\bh92344\Desktop\Auswertung neu\"
Private Const cstrSheet As String = "Schichteingabe" 'Tabelle
'Private Const cstrSheet2 As String = "Auslastung Fertigung" 'Tabelle
Private Const AnzMaschinen = 30 'Anzahl Maschinen in jedem KW-Blatt
' neu ******************
Public Jahr As String
Public Blattname As String
' neu ******************Ende******
Sub JahrInit()
Jahr = Sheets("einfache Auswertung über Jahr").Range("D1")
Blattname = "Ausfallzeiten_" & Jahr
End Sub
Sub AuswertungAusfallzeiten() 'mit direkter Übertragung der Zellwerte
Dim strFormula As String, strFile As String, strPath As String, lngKW As Long
Dim vVorgabe, Zeile As Long, Spalte As Long, Tag As Long, Zeile1 As Long, Maschine, Maschine1
Dim wbKW As Workbook, wksKW As Worksheet, wksKW2 As Worksheet
Dim wksAusfallzeiten As Worksheet, wksWochendaten As Worksheet
On Error GoTo ErrExit
' neu ******************
JahrInit
' neu ******************Ende******
' neu ****************** oder auch so ...sheets(Blattname)
Set wksAusfallzeiten = ActiveWorkbook.Worksheets("Ausfallzeiten_" & Jahr)
' neu ******************Ende******
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
'strPath = IIf(Right(cstrPath, 1) = "\", cstrPath, cstrPath & "\")
' neu ******************
strPath = cstrPath & Jahr & "\"
' neu ******************Ende******
With wksAusfallzeiten
'nächste leere Zeile in Liste in Spalte "KW"
Zeile = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
If Zeile = 2 Then ' noch keine Daten in Tabelle
lngKW = 1
Else
lngKW = .Cells(Zeile - 1, 2).Value + 1 'nächste KW
vVorgabe = Application.InputBox(Prompt:="Ab welcher KW sollen Daten eingelesen werden?" _
& vbLf & "Bei Eingabe 1 werden alle Daten neu eingelesen" _
& vbLf & "Letzte eingelesene KW: " & lngKW - 1, _
Title:="Tagesdaten der KW einlesen", Default:=lngKW, Type:=1)
If vVorgabe = False Then GoTo Beenden
If vVorgabe "" Then
'KW-Datei öffnen
Set wbKW = Workbooks.Open(Filename:=strPath & strFile, ReadOnly:=True)
Set wksKW = wbKW.Worksheets(cstrSheet)
'Daten der Tage der KW einlesen
With wksAusfallzeiten
Zeile1 = Zeile
For Tag = 1 To 6
Spalte = 8 + (Tag - 1) * 6 '1. Spalte des Tages (Anzahl Schichten)
'Werte für Jahr-KW-Datum für alle Maschinen
.Range(.Cells(Zeile, 1), .Cells(Zeile + .Cells(.Rows.Count, 30).End(xlDown), 1)). _
Value = _
wksKW.Cells(1, 1) 'Jahr aus Zelle A1 einlesen
.Range(.Cells(Zeile, 2), .Cells(Zeile + .Cells(.Rows.Count, 30).End(xlDown), 2)). _
Value = _
wksKW.Cells(1, 2) 'KW aus Zelle B1 einlesen
.Range(.Cells(Zeile, 3), .Cells(Zeile + .Cells(.Rows.Count, 30).End(xlDown), 3)). _
Value = _
wksKW.Cells(5, Spalte) 'Tages-Datum aus Zeile 5
'Werte für Daten zu den einzelnen Maschinen eintragen
For Maschine = 1 To .Cells(.Rows.Count, 30).End(xlDown) 'AnzMaschinen
Spalte = 8 + (Tag - 1) * 6 '1. Spalte des Tages (Anzahl Schichten)
.Cells(Zeile, 4).Offset(Maschine - 1, 0).Value = _
wksKW.Cells(Maschine + 30, Spalte) ' Maschine
.Cells(Zeile, 5).Offset(Maschine - 1, 0).Value = _
wksKW.Cells(Maschine + 30, Spalte + 1) 'Ausfallzeit
.Cells(Zeile, 6).Offset(Maschine - 1, 0).Value = _
wksKW.Cells(Maschine + 30, Spalte + 2) 'Grund
Next
'1. Zeile für nächsten Tag
Zeile = Zeile + .Cells(.Rows.Count, 4).End(xlUp).Row
Next
End With
'Next
'1. Zeile für nächsten Tag
'Zeile = Zeile + AnzMaschinen
'Next
'Datei mit KW_Daten wieder schliessen
wbKW.Close savechanges:=False
Set wbKW = Nothing
Set wksKW = Nothing
End If
Next lngKW
With wksAusfallzeiten
Zeile = .Cells(.Rows.Count, 2).End(xlUp).Row 'letzte Zeile mit Daten
End With
ErrExit:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
If Not wbKW Is Nothing Then wbKW.Close savechanges:=False
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Beenden:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.StatusBar = False
End With
End Sub