Auflistungen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: Auflistungen
von: Armin
Geschrieben am: 18.11.2003 06:30:11

Hallo alle miteinander,

Ich habe eine Schreinerei mit 3 Angestelten.
vor 3 Jahren habe ich mir in Excel ein Zeitprogramm zusammengestelt, das mit den Jahren immer ausgereifter wurde.
Nun möchte ich mal wieder etwas tun.
Folgendes Problem habe ich:
ich habe 3 Mitarbeiter von denen jeder eine Exceldatei besitzt in der eine Auflistung von Datum, Auftragsnummer, Auftragsbeschreibung, Bankraum Montage usw.
Ich möchte nun eine Tabelle haben in der ich in eine Zelle die Auftragsnummer eingebe, und mir dann folgendes Angezeigt wird:
1 Mitarbeiter
Datum, Bankraum , Montage, usw.
2 Mitarbeiter
Datum, Bankraum , Montage, usw.
3 Mitarbeiter
Datum, Bankraum , Montage, usw.

Es soll eine Liste erstellt werden woraus ersichtlich wird,
welcher Mitarbeiter an welchem Tag an diesem Auftrag gearbeitet hat.
Ich stelle mir das so vor:
Mitarbeiter 1
dann kommen z.b. 10 Zeilen mit Datum,Bankraum; Montage usw
Mitarbeiter 2
der hat nur z.b. an 2 Tagen an diesem Auftrag gearbeitet
Mitarbeiter 3
der hat nun wieder z.b. 7 verschiedenen Tagen daran gearbeitet.

Ich hoffe es wird einigermassen klar wo ich Eure Hilfe bräuchte!!!

Sage schon mal Danke
Gruß Armin

Bild


Betrifft: AW: Auflistungen
von: Nike
Geschrieben am: 18.11.2003 08:27:12

Moin,
könntest du die Datei mal posten?
So als alter Ex-Schreiner wär's ja mal recht interessant ;-)
Kannst ja die Werte usw. Verändern, einfach mal den Aufbau sehen,
dann schaun wir mal, was sich machen läßt.

Bye

Nike


Bild


Betrifft: AW: Auflistungen
von: Armin
Geschrieben am: 18.11.2003 09:21:18

Servus Nike

habe die Datei auf den Server, nun weis ich nicht recht weiter!!

Die Datei (Gerhard2003), muß man die dort suchen!

Dies ist eine Datei von einem Mitarbeiter.

Kannst Du damit was anfangen?

Gruß Armin


Bild


Betrifft: AW: Auflistungen
von: Nike
Geschrieben am: 18.11.2003 10:07:09

Hi,
wenn du oben bei den beiträgen die Knöpfe Durchsuchen... und Datei zum Server genutzt hast, um die Datei hochzuladen, wird dir eigentlich ein Link gezeigt,
mit einer Nummer, unter der man dann die Datei herunterladen kann...
Diese Nummer bzw. diesen Link müßtest halt posten ;-)

Bye

Nike


Bild


Betrifft: AW: Auflistungen
von: Armin
Geschrieben am: 18.11.2003 11:57:00

Super jetzt hat es geklapt,

https://www.herber.de/bbs/user/2010.xls

Diese Datei ist also von einem Mitarbeiter, von einem ganzen Jahr.
Ich möchte gerne eine Zusammenfassung von 3 Mitarbeitern von einer Auftragsnummer.
Es sollte dann nach Datum und nach Mitarbeiter sortiert erscheinen.

Danke schon mal
Gruß Armin


Bild


Betrifft: AW: Auflistungen
von: Nike
Geschrieben am: 18.11.2003 13:04:32

Hi,
welches der beiden Blätter wird denn nun ausgewertet?
Warum fangen die Gerhard zeiten erst in der Zeile 24 an?
Fangen alle auf der gleichen Höhe an?

Bye

Nike


Bild


Betrifft: AW: Auflistungen
von: Armin
Geschrieben am: 18.11.2003 14:12:31

Hi

bei Gerhard fangen die Zeiten erst in Zeile 24 an, weil wir Ihn erst eingestellt haben.
aber das dürfte ja eigendlich egal sein.
Wichtig ist der Jahresüberblick mit Datum Wochentag KW Auftragsnummer AV, MA,BA,OF,MO usw. (Tabelle Zeiten Gerhard)
Nicht die Liste mit den ganzen Auftragsnummern.

Gruß Armin


Bild


Betrifft: AW: Auflistungen
von: Nike
Geschrieben am: 18.11.2003 14:50:31

Hi,

also willst du die Auswertungsblätter der Mitarbeiter auswerten?

Bestehen die auszuwertenden Dateien normalerweise nur aus einem Blatt?
Wenn nicht müßte man sonst noch auf den Tabellennamen prüfen, daher die Frage...

Bye

Nike


Bild


Betrifft: AW: Auflistungen
von: Armin
Geschrieben am: 18.11.2003 15:10:36

Hi
jeder Mitarbeiter hat eine Datei mit jeweils zwei Tabellen (Zeiten Mitarbeiter und Auswertung Mitarbeiter)
Gruß
Armin


Bild


Betrifft: AW: Auflistungen
von: Nike
Geschrieben am: 18.11.2003 15:15:51

Hi,
ok, hier ein Anfang.
Voraussetzungen:
Es gibt nur Tabellen die an erster Stelle Blätter vom Format
Name Zeiten 2003 haben
als Auswertungskriterium wird die Auftrg Nr gegeben, z.B. 201-194

Dann mal das hier ausprobieren:


Sub Auswert()
Dim arrFilenames As Variant
Dim wkbArr As Workbook
Dim wkbBasis As Workbook
Dim wksBasis As Worksheet
Dim wksArr As Worksheet
Dim lngZeil As Long
Dim lngZZeil As Long
Dim lngLZeil As Long
Dim strAuftragNr As String
strAuftragNr = Application.InputBox("Bitte die Auftragsnummer eingeben, nach der gesucht werden soll", "Auftragsnummer")
If strAuftragNr = "" Or strAuftragNr = "Falsch" Then Exit Sub
Set wkbBasis = ActiveWorkbook
Set wksBasis = wkbBasis.Worksheets.Add
Selection:
    ' Zu öffnende Dateien erfragen
    arrFilenames = Application.GetOpenFilename( _
        "Exceldateien (*.xls), *.xls, Alle Dateien (*.*), *.*", 1, _
        "Exceldateien auswählen...", MultiSelect:=True)              ' Ausgewählte Dateien des Öffnen-Dialoges in Feld ablegen
    If VarType(arrFilenames) = vbBoolean Then
        If MsgBox("Sie haben keine Dateien ausgewählt. Möchten sie das Makro beenden?", vbYesNo, "Frage") = vbNo Then
            GoTo Selection
        Else
            Set wbkBasis = Nothing
            Exit Sub
        End If
    End If
    
    Application.ScreenUpdating = False
    'Die vom Makro vorgenommenen Tätigkeiten
    'bleiben zur Geschwidigkeitssteigerung unsichtbar
lngZZeil = 1
    For i = 1 To UBound(arrFilenames) ' Durchläuft die Anzahl der Dateien
        'Wenn Datei noch nicht geöffnet
        If FileOpenYet(Dir$(arrFilenames(i))) = False Then
            'dann öffnen
            Workbooks.Open FileName:=arrFilenames(i)
        Else
            'oder aktivieren
            Workbooks(Dir$(arrFilenames(i))).Activate
        End If
        Set wkbArr = ActiveWorkbook
        '-------------------------------------------------------
        'hier kommt dann der Code rein, der die ausgewählten Dateien
        'betrifft. Die Ursprungsdatei ist über wbkBasis ansprechbar.
        lngZeil = 4
        Set wksArr = wkbArr.Worksheets(1)
        lngLZeil = wksArr.Cells(wksArr.Rows.Count, 5).End(xlUp).Row
        datTag = CDate(wksArr.Cells(lngZeil, 3))
        Do
            lngZeil = lngZeil + 1
            lngStep = lngStep + 1
            If lngStep = 10 Then
                datTag = DateSerial(wksArr.Cells(lngZeil, 2), Month(wksArr.Cells(lngZeil, 4)), Day(wksArr.Cells(lngZeil, 4)))
                lngStep = 0
            End If
            If wksArr.Cells(lngZeil, 5) = strAuftragNr Then
                wksBasis.Cells(lngZZeil, 1).Value = Left(wksArr.Name, InStr(1, wksArr.Name, " ") - 1)
                wksBasis.Cells(lngZZeil, 2).Value = strAuftragNr
                wksBasis.Cells(lngZZeil, 3).Value = datTag
                wksArr.Range(wksArr.Cells(lngZeil, 7), wksArr.Cells(lngZeil, 12)).Copy _
                    wksBasis.Range(wksBasis.Cells(lngZZeil, 7), wksBasis.Cells(lngZZeil, 12))
                lngZZeil = lngZZeil + 1
            End If
        Loop Until lngZeil = lngLZeil
        wkbArr.Close SaveChanges:=False    'Datei schließen
        Set wkbArr = Nothing
        '-------------------------------------------------------
    Next i
    Set wkbArr = Nothing
    'Ursprüngliche Datei wieder aktivieren
    wkbBasis.Activate
    Set wkbBasis = Nothing 'Die Variable zurücksetzen
    'und den Monitor aktivieren
    Application.ScreenUpdating = True
End Sub




Function FileOpenYet(FileName As String) As Boolean
'eine Funktion, die Prüft ob eine Datei schon geöffnet ist.
    Dim s As String
    On Error GoTo Nonexistent
    s = Workbooks(FileName).Name
    FileOpenYet = True
    Exit Function
Nonexistent:
    FileOpenYet = False
End Function


bye

Nike

P.S. Das die Wiederberechnungszeiten deiner Millionen Formeln ziemlich
heftig is, ist dir schon klar, oder? ;-)
P.P.S. Die Datumsangaben sind ein bischen komisch, daher weis ich auch nicht, warum es beim Berechnen der Datumsangaben so komische Ergebnisse gibt...
Hättest beim AUfbau der Seiten schon mit dem richtigen Datum arbeiten sollen und nicht mit 1900, durch formatieren der Zelle kann man auch 01.01.2003
auf Januar oder 2003 umformatieren...


Bild


Betrifft: AW: Auflistungen
von: Armin
Geschrieben am: 18.11.2003 15:49:16

Hi Nike,

dies sieht ja gigantisch aus!!!!

Weis nicht so recht was ich damit anfangen soll.

Kannst Du es mir etwas "verdeutschen" wie ich damit umgehen soll?

Gruß Armin


Bild


Betrifft: AW: Auflistungen
von: Nike
Geschrieben am: 19.11.2003 10:19:47

Moin,
also, verdeutscht würd ich sagen, du legst ein neue Code Modul
in deiner Datei im VBA Editor an und kopierst dann den folgenden Code:


Sub Auswert()
Dim arrFilenames As Variant
Dim wkbArr As Workbook
Dim wkbBasis As Workbook
Dim wksBasis As Worksheet
Dim wksArr As Worksheet
Dim lngZeil As Long
Dim lngZZeil As Long
Dim lngLZeil As Long
Dim strAuftragNr As String
strAuftragNr = Application.InputBox("Bitte die Auftragsnummer eingeben, nach der gesucht werden soll", "Auftragsnummer")
If strAuftragNr = "" Or strAuftragNr = "Falsch" Then Exit Sub
Set wkbBasis = ActiveWorkbook
Set wksBasis = wkbBasis.Worksheets.Add
Selection:
    ' Zu öffnende Dateien erfragen
    arrFilenames = Application.GetOpenFilename( _
        "Exceldateien (*.xls), *.xls, Alle Dateien (*.*), *.*", 1, _
        "Exceldateien auswählen...", MultiSelect:=True)              ' Ausgewählte Dateien des Öffnen-Dialoges in Feld ablegen
    If VarType(arrFilenames) = vbBoolean Then
        If MsgBox("Sie haben keine Dateien ausgewählt. Möchten sie das Makro beenden?", vbYesNo, "Frage") = vbNo Then
            GoTo Selection
        Else
            Set wbkBasis = Nothing
            Exit Sub
        End If
    End If
    
    Application.ScreenUpdating = False
    'Die vom Makro vorgenommenen Tätigkeiten
    'bleiben zur Geschwidigkeitssteigerung unsichtbar
lngZZeil = 1
    For i = 1 To UBound(arrFilenames) ' Durchläuft die Anzahl der Dateien
        'Wenn Datei noch nicht geöffnet
        If FileOpenYet(Dir$(arrFilenames(i))) = False Then
            'dann öffnen
            Workbooks.Open FileName:=arrFilenames(i)
        Else
            'oder aktivieren
            Workbooks(Dir$(arrFilenames(i))).Activate
        End If
        Set wkbArr = ActiveWorkbook
        '-------------------------------------------------------
        'hier kommt dann der Code rein, der die ausgewählten Dateien
        'betrifft. Die Ursprungsdatei ist über wbkBasis ansprechbar.
        lngZeil = 4
        If Right(wkbArr.Worksheets(1).Name, 11) = "Zeiten 2003" Then
            Set wksArr = wkbArr.Worksheets(1)
        ElseIf Right(wkbArr.Worksheets(2).Name, 11) = "Zeiten 2003" Then
            Set wksArr = wkbArr.Worksheets(2)
        Else
            Exit Sub
        End If
        
        lngLZeil = wksArr.Cells(wksArr.Rows.Count, 5).End(xlUp).Row
        datTag = CDate(wksArr.Cells(lngZeil, 3))
        Do
            lngZeil = lngZeil + 1
            lngStep = lngStep + 1
            If lngStep = 10 Then
                datTag = DateSerial(wksArr.Cells(lngZeil, 2), Month(wksArr.Cells(lngZeil, 4)), Day(wksArr.Cells(lngZeil, 4)))
                lngStep = 0
            End If
            If wksArr.Cells(lngZeil, 5) = strAuftragNr Then
                wksBasis.Cells(lngZZeil, 1).Value = Left(wksArr.Name, InStr(1, wksArr.Name, " ") - 1)
                wksBasis.Cells(lngZZeil, 2).Value = strAuftragNr
                wksBasis.Cells(lngZZeil, 3).Value = datTag
                wksArr.Range(wksArr.Cells(lngZeil, 7), wksArr.Cells(lngZeil, 12)).Copy _
                    wksBasis.Range(wksBasis.Cells(lngZZeil, 7), wksBasis.Cells(lngZZeil, 12))
                lngZZeil = lngZZeil + 1
            End If
        Loop Until lngZeil = lngLZeil
        wkbArr.Close SaveChanges:=False    'Datei schließen
        Set wkbArr = Nothing
        '-------------------------------------------------------
    Next i
    Set wkbArr = Nothing
    'Ursprüngliche Datei wieder aktivieren
    wkbBasis.Activate
    Set wkbBasis = Nothing 'Die Variable zurücksetzen
    'und den Monitor aktivieren
    Application.ScreenUpdating = True
End Sub




Function FileOpenYet(FileName As String) As Boolean
'eine Funktion, die Prüft ob eine Datei schon geöffnet ist.
    Dim s As String
    On Error GoTo Nonexistent
    s = Workbooks(FileName).Name
    FileOpenYet = True
    Exit Function
Nonexistent:
    FileOpenYet = False
End Function


Anschließend speicherst du die Datei
und rufst dann die Prozedur Auswerten
mittels der Tastenkombination Alt F8 auf.
Anschließend wählst du deine Mitarbeiterdateien aus.
Es sollte dann ein neues Blatt angelegt werden,
in dem dann die Werte stehen...

Bye

Nike


Bild

Beiträge aus den Excel-Beispielen zum Thema " Inputbox"