Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1216to1220
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

nochmal hilfe

nochmal hilfe
Burkhard
Hallo Forum Leute,
habe hier letzte Woche eine Super hilfe bekommen, nur leider habe ich es etwas anpassen wollen und scheinbar fehler eingebaut, kein wunder so ein leihe wie ich in VBA bin!!!
Nun mein Problem, als erstes ist es so gewesen, das daß Tabellenblatt Auslastung Fertigung nicht überein stimmte mit dem aktuellen was ich verwende, noch schnell vorab, die tabelleblätter "Auslastung fertigung & Schichteingabe" sind Blätter die immer zusammen in einer Datei sind und wöchendlich neu abgespeichert werden. Soll heißen, für jede KW existiert eine Datei und wird über das Makro ausgelesen, das funzte soweit auch ganz gut!!!
nun wollte ich es zusätzlich noch verfeinern und die Gesamtstückzahl je tag und Maschine aus dem Tabellenblatt "Auslastung Ferticgung auslesen und im Tabelleblatt "Tagesdaten in Spalte 9 abspeichern.
Die Schichtstückzahlen dazu möchte ich aus dem Tabellenblatt "Schichteingabe jeweils zum Tag & Maschine auslesen und im Tabellenblatt Tagesdaten in den dazugehörigen Schichten speichern.
Hoffe ich konnte mich einigermaßen passend ausdrücken, werde ja die Datei mit Hochladen.
Über hilfe würde ich mich sehr freuen, danke auch noch an fcs, vielleicht liest du dieses ja auch und kannst nochmal helfen!!!!
Grüße Burkhard
https://www.herber.de/bbs/user/75430.xls

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: nochmal hilfe
27.06.2011 09:01:15
Dirk
Hallo Burkhard,
kopiere dieses Makro in Dein Tabellenblatt 'Tagesdaten'
Private Sub Worksheet_Activate()
'Tabelleneintraegeaktualisieren
Dim SourceSh As Worksheet, TargetSh As Worksheet, MyFind As Range
Dim FirstRow As Long, LastRow As Long, CalDays As Long, MaschAnz As Long
Dim i As Long, k As Long, DayRow As Long, DayName As String, DayCol As Long
Dim TargetRow As Long, EmptySh As Boolean, Cell As Object
CalDays = 6    'Sonntag is arbeitsfrei und wird nicht beruecksichtigt. Falls doch, Wert auf 7  _
hochsetzen
DayRow = 4
Set SourceSh = Sheets("Auslastung Fertigung")     'Ursprungsblatt der Daten setzen
Set TargetSh = ActiveSheet                        'Zielblatt fuer die Daten setzen
EmptySh = False
With SourceSh
'Erste Datenzeile finden
With .Range("A:A")
Set MyFind = .Find(what:="Maschine", LookIn:=xlValues, lookat:=xlWhole)
If Not MyFind Is Nothing Then
FirstRow = MyFind.Offset(1, 0).Row
Else
MsgBox "Spaltenbezeichnung 'Maschine' im Blatt '" & SourceSh.Name & "' konnte  _
nicht gefunden werden." & vbCrLf & _
"Blatt '" & TargetSh.Name & "' kann nicht aktualisiert werden! Bitte  _
Schreibweise und Blattnamen pruefen", 48, "Fehler"
Exit Sub
End If
Set MyFind = Nothing
Set MyFind = .Find(what:="Anzahl", LookIn:=xlValues, lookat:=xlWhole)
If Not MyFind Is Nothing Then
LastRow = MyFind.Offset(-1, 0).Row
Else
MsgBox "Zelleintrag 'Anzahl' im Blatt '" & SourceSh.Name & "' konnte nicht  _
gefunden werden." & vbCrLf & _
"Blatt '" & TargetSh.Name & "' kann nicht aktualisiert werden! Bitte  _
Schreibweise und Blattnamen pruefen", 48, "Fehler"
Exit Sub
End If
Set MyFind = Nothing
End With
End With
MaschAnz = LastRow - (FirstRow - 1)
Application.Calculation = xlManual
For i = FirstRow To LastRow   'Schleife ueber all Maschinen
For k = 1 To CalDays      'Schleife ueber all Kalendertage
'Dayname ableiten
Select Case k
Case 1
DayName = "Mo"
Case 2
DayName = "Di"
Case 3
DayName = "Mi"
Case 4
DayName = "Do"
Case 5
DayName = "Fr"
Case 6
DayName = "Sa"
Case 7
DayName = "So"
End Select
'finde ersten wochentag in Tageszeile
With SourceSh.Rows(DayRow)
For Each Cell In .Cells
If Cell.Value = DayName Then
DayCol = Cell.Column   'setze erste Spalte der Tagesdaten
GoTo exit_sub
End If
Next Cell
If Cell.Column = 256 Then
MsgBox "Zelleintrag '" & DayName & "' im Blatt '" & SourceSh.Name & "' konnte  _
nicht gefunden werden." & vbCrLf & _
"Blatt '" & TargetSh.Name & "' kann nicht aktualisiert werden! Bitte  _
Schreibweise und Blattnamen pruefen", 48, "Fehler"
Exit Sub
End If
If EmptySh = False Then
GoSub Empty_sheet
End If
'Schreibe Daten in TargetSh
With TargetSh
.Cells(TargetRow, 3) = SourceSh.Cells(5, DayCol)           'Datum
.Cells(TargetRow, 4) = SourceSh.Cells(i, 1).Value          'Maschine
.Cells(TargetRow, 6) = SourceSh.Cells(i, DayCol).Value     'Anzahl Schichten
.Cells(TargetRow, 7) = SourceSh.Cells(i, DayCol + 1).Value 'Soll Stueckzahl 3  _
Tage
.Cells(TargetRow, 8) = SourceSh.Cells(i, DayCol + 2).Value 'Soll Stueckzahl
.Cells(TargetRow, 9) = SourceSh.Cells(i, DayCol + 3).Value 'Ist-Stueckzahl
TargetRow = TargetRow + 1
End With
End With
Next k
Next i
GoTo exit_sub
Empty_sheet:
'pruefe ob daten in TaregtSh enthalten sind
If TargetSh.Range("A65536").End(xlUp).Row = 1 Then
'Tabelle ist leer, neu anlegen
Else
'Tabelle enthaelt daten, leere Tabelle und schreibe neu
TargetSh.Range("A2:K65536").Delete
End If
TargetRow = 2
EmptySh = True
Return::
exit_sub:
Application.Calculation = xlAutomatic
End Sub
Lass' hoeren, ob ok.
Gruss
Dirk aus Dubai
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige