Makro anpassen "Zeilen Zählen"
11.04.2016 19:43:18
Burkhard
ich hatte letzte Woche schon ein Problem, welches ich zum teil lösen konnte.
Es ging darum, ein Makro anzupassen, mit dem ich Werte von einer Excelmappe in eine mappe eintragen wollte.
Das übertragen der Daten habe ich auch geschafft, mein Problem liegt nun darin, das ich für jeden Wochentag unterschiedlich viele Einträge übertragen muß.
mein Vorhandenes Makro macht hier einiges richtig, aber eben deswegen ist es auch ziemlich komplex und für mich schwer anzupassen. Vielleicht könnt ihr mir hier weiterhelfen.
Derzeit habe ich es soweit, das ich oben unter Anzahl Maschinen einen festen Wert eintragen habe und soviel Werte würde er auch ab Zeile 29 einlesen.
Und in die Tabelle Ausfallzeiten_2016 eintragen.
Wichtig ist, die Art, der Schleife, wie sie heute im Makro ist, ist auch Richtig, nun die Anzahl der Werte ist heute auf die Anzahl an Maschinen begrenzt, und das darf nicht sein. Es kann sein, das ich Montag mal nur 10 Zeilen einlesen muß, aber Dienstag dafür 100 werte.
https://www.herber.de/bbs/user/104903.xlsx
Option Explicit
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
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 + AnzMaschinen - 1, 1)).Value = _
wksKW.Cells(1, 1) 'Jahr aus Zelle A1 einlesen
.Range(.Cells(Zeile, 2), .Cells(Zeile + AnzMaschinen - 1, 2)).Value = _
wksKW.Cells(1, 2) 'KW aus Zelle B1 einlesen
.Range(.Cells(Zeile, 3), .Cells(Zeile + AnzMaschinen - 1, 3)).Value = _
wksKW.Cells(5, Spalte) 'Tages-Datum aus Zeile 5
'Werte für Daten zu den einzelnen Maschinen eintragen
For Maschine = 1 To 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 + AnzMaschinen
Next
End With
'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