Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Hilfe bei Maschinen-Schichtdatenauswertung
zurück: Find findet erstes Element im Bereich nicht weiter: Bestimmte Zelle aus mehreren Tabellenblättern in ein Blatt Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Feedback Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Pscht2010
Einsteiger


Verfasst am:
24. Sep 2010, 11:16
Rufname:

Hilfe bei Maschinen-Schichtdatenauswertung - Hilfe bei Maschinen-Schichtdatenauswertung

Nach oben
       Version: Office 2003

Hallo zusammen,

ich brauche ein klein wenig Hilfe: Ich habe aus einer PPS-Software eine Excelliste exportiert, die ungefähr so aussieht wie die im Anhang.
Daraus will ich ein Diagramm über die Schichtdaten einer Maschine erstellen. Leider kenn ich mich dazu mit Makros nicht so gut aus, ich weiß zwar was ich will/brauche aber aus den Treffern im Inet habe ich bisher nichts wirklich passendes gefunden.

Die Sortierung müsste folgendermaßen aussehen:

- die Liste sollte natürlich nach Datum sortiert sein, aber ich brauche gleichzeitig auch die Sortierung nach den Schichten. Sollte also so aussehen:
Datum Schicht
13.09.10 1
13.09.10 2
13.09.10 3
usw.
Die zeilen mit den Nullschichten sollten vorher entfernt werden. Dafür habe ich schon ein makro gefunden, dieses entfernt die Nullzeilen aber nicht zuverlässig

- Wenn unter einem Datum mehrmals die gleiche Schicht steht (z.B. hier der 14.09. mit zweimal Schicht 1), müssten die Gut- und Ausschussteile addiert werden.

Ich hoffe, ich verlange jetzt nicht zu viel auf einmal, aber ich habe wie gesagt bisher leider wenig Ahnung von Makros (außer copy-paste aus dem Inet Smile ), würde es aber gerne verstehen und anwenden können.

vielen Dank schon mal!

Grüße

P.S.: Ich kann leider (noch) keine Dateien mit hochladen, darum die Tabelle als Anhang:

Datum Schicht Gutteile Ausschuss
17.09.2010 0 1 0
13.09.2010 0 3 0
14.09.2010 1 4 0
13.09.2010 1 5 0
17.09.2010 2 5 0
16.09.2010 3 7 0
13.09.2010 2 9 0
14.09.2010 2 9 0
14.09.2010 3 9 1
16.09.2010 2 9 0
17.09.2010 3 9 1
16.09.2010 0 11 0
15.09.2010 2 12 1
14.09.2010 1 15 1
15.09.2010 1 15 0
13.09.2010 3 20 1
16.09.2010 1 22 1
17.09.2010 2 23 0
Phelan XLPH
Fortgeschritten


Verfasst am:
24. Sep 2010, 15:33
Rufname: Phelan


AW: Hilfe bei Maschinen-Schichtdatenauswertung - AW: Hilfe bei Maschinen-Schichtdatenauswertung

Nach oben
       Version: Office 2003

Hallo,

Code:
Sub ph()
    Dim Bereich As Range, B_Data As Range
    Dim anzZ As Long
    Set Bereich = Tabelle4.UsedRange
   
    '"0"-Schichten löschen
    With Bereich
        .Sort .Cells(2), xlDescending, Header:=xlYes
        With .Columns(2)
            .Replace 0, True, xlWhole
            On Error Resume Next
            .SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
            On Error GoTo 0
        End With
    End With
       
    With Bereich
        Set B_Data = .Resize(.Rows.Count - 1, .Columns.Count).Offset(1)
    End With
       
    B_Data.Columns(B_Data.Columns.Count).Offset(, 1).Formula = _
    "=SUMPRODUCT((" & B_Data.Columns(1).Address & "&" & B_Data.Columns(2).Address & "=" & B_Data.Cells(1).Address(0, 0) & "&" & B_Data.Cells(2).Address(0, 0) & ")*" & B_Data.Columns(3).Address & ")"
    B_Data.Columns(B_Data.Columns.Count).Offset(, 2).Formula = _
    "=SUMPRODUCT((" & B_Data.Columns(1).Address & "&" & B_Data.Columns(2).Address & "=" & B_Data.Cells(1).Address(0, 0) & "&" & B_Data.Cells(2).Address(0, 0) & ")*" & B_Data.Columns(4).Address & ")"

    With B_Data.Resize(, B_Data.Columns.Count - 2)
        .Offset(, 4).Copy
        .Offset(, 2).PasteSpecial xlPasteValues
        .Offset(, 4).ClearContents
    End With
   
    With B_Data
        With .Columns(.Columns.Count).Offset(, 1)
            anzZ = .Rows.Count + 1
            .Formula = "=IF(SUMPRODUCT(($A2:$A$" & anzZ & "&$B2:$B$" & anzZ & "&$C2:$C$" & anzZ & "&$D2:$D$" & anzZ & "=A2&B2&C2&D2)*1)=1,"""",TRUE)"
            .Copy
            .PasteSpecial xlPasteValues
            .EntireRow.Sort .Cells(1), xlAscending, Header:=xlNo
            On Error Resume Next
            .SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
            On Error GoTo 0
            .ClearContents
        End With
    End With
   
    With B_Data
        .Sort .Cells(1), xlAscending, .Cells(2), , xlAscending, Header:=xlNo
    End With

End Sub

_________________
Was vorstellbar ist, ist auch machbar. - Albert Einstein
Pscht2010
Einsteiger


Verfasst am:
24. Sep 2010, 18:52
Rufname:

AW: Hilfe bei Maschinen-Schichtdatenauswertung - AW: Hilfe bei Maschinen-Schichtdatenauswertung

Nach oben
       Version: Office 2003

Scheint auf den ersten Blick zu funktionieren, ich werds aber noch ausführlich testen! Danke für die schnelle Antwort. Jetzt will ich das Makro nur noch verstehen...
Phelan XLPH
Fortgeschritten


Verfasst am:
24. Sep 2010, 20:54
Rufname: Phelan

AW: Hilfe bei Maschinen-Schichtdatenauswertung - AW: Hilfe bei Maschinen-Schichtdatenauswertung

Nach oben
       Version: Office 2003

Hallo nochmal,

nimm den Code, der ist nicht so kompliziert (M.E.).

Code:
Private Type SchichtDaten
    Datum       As Object
    Schicht     As Object
    Gutteile    As Object
    Ausschuss   As Object
End Type

Public Dic As SchichtDaten

Sub SchichtDaten_Auswerten()
    Dim arr     As Variant
    Dim i       As Long
    Dim krit    As String
    Set Dic.Datum = CreateObject("Scripting.Dictionary")
    Set Dic.Schicht = CreateObject("Scripting.Dictionary")
    Set Dic.Gutteile = CreateObject("Scripting.Dictionary")
    Set Dic.Ausschuss = CreateObject("Scripting.Dictionary")
   
    arr = Tabelle1.Range("A1").CurrentRegion 'Anpassen Quelle *******
   
    For i = 1 To UBound(arr)
        If arr(i, 2) <> 0 Then
            krit = arr(i, 1) & arr(i, 2)
            Dic.Datum(krit) = arr(i, 1)
            Dic.Schicht(krit) = arr(i, 2)
            Dic.Gutteile(krit) = Dic.Gutteile(krit) + arr(i, 3)
            Dic.Ausschuss(krit) = Dic.Ausschuss(krit) + arr(i, 4)
        End If
    Next
   
    With Tabelle3 'Anpassen Ziel *************************************
        .Range("A1").CurrentRegion.Clear
       
        .Range("A1").Resize(Dic.Datum.Count) = _
        WorksheetFunction.Transpose(Dic.Datum.Items)
        .Range("B1").Resize(Dic.Schicht.Count) = _
        WorksheetFunction.Transpose(Dic.Schicht.Items)
        .Range("C1").Resize(Dic.Gutteile.Count) = _
        WorksheetFunction.Transpose(Dic.Gutteile.Items)
        .Range("D1").Resize(Dic.Ausschuss.Count) = _
        WorksheetFunction.Transpose(Dic.Ausschuss.Items)
       
        With .Range("A1").CurrentRegion
            .Sort .Cells(1), xlAscending, .Cells(2), , xlAscending, Header:=xlYes
        End With
    End With
   
End Sub

_________________
Was vorstellbar ist, ist auch machbar. - Albert Einstein
Phelan XLPH
Fortgeschritten


Verfasst am:
24. Sep 2010, 22:50
Rufname: Phelan


AW: Hilfe bei Maschinen-Schichtdatenauswertung - AW: Hilfe bei Maschinen-Schichtdatenauswertung

Nach oben
       Version: Office 2003

So langsam komm ich in Fahrt... Very Happy Cool

noch etwas kürzer:

Code:
Private Type SchichtDaten
    wert()      As Object
End Type

Sub SchichtDaten_Auswerten()
    Dim arr     As Variant
    Dim i       As Long
    Dim k       As Long
    Dim krit    As String
    Dim t As Double
   
    Dim Dic As SchichtDaten
   
    t = Timer
   
    arr = Tabelle1.Range("A1").CurrentRegion 'Anpassen Quelle *******
   
    ReDim Dic.wert(1 To UBound(arr, 2))
    For i = 1 To UBound(arr, 2)
        Set Dic.wert(i) = CreateObject("Scripting.Dictionary")
    Next
   
    For i = 1 To UBound(arr)
        If arr(i, 2) <> 0 Then
            krit = arr(i, 1) & arr(i, 2)
            For k = 1 To UBound(arr, 2)
                If k < 3 Then
                    Dic.wert(k)(krit) = arr(i, k)
                Else
                    Dic.wert(k)(krit) = Dic.wert(k)(krit) + arr(i, k)
                End If
            Next
        End If
    Next
   
    With Tabelle3 'Anpassen Ziel *************************************
        .Range("A1").CurrentRegion.Clear
        For k = 1 To UBound(arr, 2)
            .Cells(1, k).Resize(Dic.wert(k).Count) = _
            WorksheetFunction.Transpose(Dic.wert(k).Items)
        Next
        With .Range("A1").CurrentRegion
            .Sort .Cells(1), xlAscending, .Cells(2), , xlAscending, Header:=xlYes
        End With
    End With
    MsgBox Timer - t
End Sub

_________________
Was vorstellbar ist, ist auch machbar. - Albert Einstein
Pscht2010
Einsteiger


Verfasst am:
25. Sep 2010, 11:56
Rufname:

AW: Hilfe bei Maschinen-Schichtdatenauswertung - AW: Hilfe bei Maschinen-Schichtdatenauswertung

Nach oben
       Version: Office 2003

Scheint super zu funktionieren, konkrete Rückmeldung kann ich aber erst am Montag in der Arbeit geben, wenn ich mit den "echten" Daten arbeiten kann.

Eine Frage hätt ich noch: Wie müsste ein Makro aussehen, dass mir bestimmte Zellen erstmal in ein neues/anderes Tabellenblatt kopiert? Ich importier ja die Infos aus einer PPS-Software und da ist auch viel "Rotz" dabei. Ich möchte also erstmal die relevanten Daten rauskopieren und dann dein makro drüber laufen lassen...

DANKE VIELMALS!

P.S.: Leider kapier ich nur gar nicht, wie das Makro arbeitet... Will in Zukunft ja mehr selbst machen können...
Phelan XLPH
Fortgeschritten


Verfasst am:
25. Sep 2010, 12:39
Rufname: Phelan

AW: Hilfe bei Maschinen-Schichtdatenauswertung - AW: Hilfe bei Maschinen-Schichtdatenauswertung

Nach oben
       Version: Office 2003

zum Kopieren: bedien die Suchmaschine

Die letzten beiden Codes sind nicht einfach zu verstehen.
Dafür benötigen diese lediglich 1,093 sec. bei 65530 Datensätzen.

Hier hab ich noch einen, der vielleicht verständlicher ist:
Code:
Sub SpezialFilter_Variante() 'sehr langsam bei großen Datenmengen
    Dim wsQ As Worksheet
    Dim wsZ As Worksheet
    Dim rngF As Range
   
    Dim t As Single
    'Application.ScreenUpdating = False
   
    Set wsQ = Tabelle1
    Set wsZ = Tabelle3
   
    t = Timer
   
   
    With wsQ.Range("A1").CurrentRegion
        Set rngF = .Resize(.Rows.Count - 1).Offset(1)
    End With
   
    wsZ.Range("A1").CurrentRegion.Clear
   
    wsZ.Range("B2").Formula = "=B2<>0"
    wsQ.Range("A1").CurrentRegion.Columns("A:B").AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=wsZ.Range("A1:B2"), _
        CopyToRange:=wsZ.Range("A3"), _
        Unique:=True
    wsZ.Rows("1:2").Delete
       
    wsQ.Range("C1:D1").Copy wsZ.Range("C1")
    With wsZ.Range("C2:D" & wsZ.Cells(Rows.Count, 1).End(xlUp).Row)
        .Formula = "=SUMPRODUCT((" & _
        rngF.Columns(1).Address(, , , True) & "&" & _
        rngF.Columns(2).Address(, , , True) & "=$A2&$B2)*(" & _
        rngF.Columns(3).Address(, 0, , True) & "))"
        .Copy
        .PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End With
    'Application.ScreenUpdating = True
    MsgBox Timer - t
End Sub

_________________
Was vorstellbar ist, ist auch machbar. - Albert Einstein
Pscht2010
Einsteiger


Verfasst am:
27. Sep 2010, 09:19
Rufname:

AW: Hilfe bei Maschinen-Schichtdatenauswertung - AW: Hilfe bei Maschinen-Schichtdatenauswertung

Nach oben
       Version: Office 2003

Das Makro funktioniert soweit gut, nur haben sich die Anforderungen ein bisschen verändert. Ich habe zu den bisherigen Spalten noch folgende dazu:

Benennung und FA-Nummer.

Die Tabelle sieht jetzt z.B. so aus:

Datum Schicht Gutteile Ausschuss Artikel FA-Nummer
20.09.2010 0 0 0 Artikel 1 1
20.09.2010 1 55 0 Artikel 1 1
20.09.2010 2 0 0 Artikel 1 1
20.09.2010 3 0 0 Artikel 1 1
21.09.2010 0 0 0 Artikel 1 1
21.09.2010 1 0 0 Artikel 1 1
21.09.2010 2 0 0 Artikel 1 1
21.09.2010 3 0 0 Artikel 1 1
22.09.2010 3 548 0 Artikel 1 1
22.09.2010 0 0 0 Artikel 1 2
22.09.2010 1 0 0 Artikel 1 2
22.09.2010 2 70 0 Artikel 1 2
22.09.2010 3 0 0 Artikel 1 2
23.09.2010 0 0 0 Artikel 1 2
23.09.2010 1 118 0 Artikel 1 2
23.09.2010 3 156 0 Artikel 1 2
23.09.2010 0 0 0 Artikel 1 3
23.09.2010 1 0 0 Artikel 1 3
23.09.2010 2 0 0 Artikel 1 3
24.09.2010 0 42 0 Artikel 1 3
24.09.2010 1 152 0 Artikel 1 3
24.09.2010 2 0 0 Artikel 1 3
24.09.2010 3 77 0 Artikel 1 3

Wenn ich das bisherige Makro anwende, überschreibt er mir diese Spalten. Hab auch glaub ich schon herausgefunden warum, aber ganz bekomm ichs nicht hin...

Da ja alle alle gleichen Schichten an einem Tag zusammengezählt werden, sollte dabei als FA-Nummer und Artikel jeweils derjenige erhalten bleiben, der die meisten Gutteile hatte... Wie kann man das realisieren?

VIELEN VIELEN DANK!

edit: habe jetzt auf Basis des letzten Codes von dir (mit dem komm ich am besten zurecht) die zusätzlichen Spalten hinzugefügt.
Mir ist klar, dass die Befehle nicht ganz stimmen, Excel Addiert jetzt auch die FA-Nummer... Kannst du mir das noch anpassen?

Code:
Private Type SchichtDaten
    Datum       As Object
    Schicht     As Object
    Gutteile    As Object
    Ausschuss   As Object
    Artikel     As Object
    FANummer    As Object
   
End Type

Public Dic As SchichtDaten

Sub SchichtDaten_Auswerten()
    Dim arr     As Variant
    Dim i       As Long
    Dim krit    As String
    Set Dic.Datum = CreateObject("Scripting.Dictionary")
    Set Dic.Schicht = CreateObject("Scripting.Dictionary")
    Set Dic.Gutteile = CreateObject("Scripting.Dictionary")
    Set Dic.Ausschuss = CreateObject("Scripting.Dictionary")
    Set Dic.Artikel = CreateObject("Scripting.Dictionary")
    Set Dic.FANummer = CreateObject("Scripting.Dictionary")
   
   
    arr = Tabelle2.Range("A1").CurrentRegion 'Anpassen Quelle *******
   
    For i = 1 To UBound(arr)
        If arr(i, 2) <> 0 Then
            krit = arr(i, 1) & arr(i, 2)
            Dic.Datum(krit) = arr(i, 1)
            Dic.Schicht(krit) = arr(i, 2)
            Dic.Gutteile(krit) = Dic.Gutteile(krit) + arr(i, 3)
            Dic.Ausschuss(krit) = Dic.Ausschuss(krit) + arr(i, 4)
            Dic.Artikel(krit) = Dic.Artikel(krit) + arr(i, 5)
            Dic.FANummer(krit) = Dic.FANummer(krit) + arr(i, 6)
        End If
    Next
   
    With Tabelle3 'Anpassen Ziel *************************************
        .Range("A1").CurrentRegion.Clear
       
        .Range("A1").Resize(Dic.Datum.Count) = _
        WorksheetFunction.Transpose(Dic.Datum.Items)
        .Range("B1").Resize(Dic.Schicht.Count) = _
        WorksheetFunction.Transpose(Dic.Schicht.Items)
        .Range("C1").Resize(Dic.Gutteile.Count) = _
        WorksheetFunction.Transpose(Dic.Gutteile.Items)
        .Range("D1").Resize(Dic.Ausschuss.Count) = _
        WorksheetFunction.Transpose(Dic.Ausschuss.Items)
        .Range("E1").Resize(Dic.Artikel.Count) = _
        WorksheetFunction.Transpose(Dic.Artikel.Items)
        .Range("F1").Resize(Dic.FANummer.Count) = _
        WorksheetFunction.Transpose(Dic.FANummer.Items)
       
       
       
        With .Range("A1").CurrentRegion
            .Sort .Cells(1), xlAscending, .Cells(2), , xlAscending, Header:=xlYes
        End With
    End With
   
End Sub

Pscht2010
Einsteiger


Verfasst am:
27. Sep 2010, 18:40
Rufname:

AW: Hilfe bei Maschinen-Schichtdatenauswertung - AW: Hilfe bei Maschinen-Schichtdatenauswertung

Nach oben
       Version: Office 2003

Habe mich jetzt nochmal damit befasst und den Code einigermaßen verstanden. Würde gerne bei dieser Version des Codes bleiben. Hab ihn folgendermaßen modifiziert:


Code:
Private Type SchichtDaten
    Datum       As Object
    Schicht     As Object
    Gutteile    As Object
    Ausschuss   As Object
    Artikel     As Object
    FA   As Object
   
End Type

Public Dic As SchichtDaten

Sub SchichtDaten_Auswerten()
    Dim arr     As Variant
    Dim i       As Long
    Dim krit    As String
    Set Dic.Datum = CreateObject("Scripting.Dictionary")
    Set Dic.Schicht = CreateObject("Scripting.Dictionary")
    Set Dic.Gutteile = CreateObject("Scripting.Dictionary")
    Set Dic.Ausschuss = CreateObject("Scripting.Dictionary")
    Set Dic.Artikel = CreateObject("Scripting.Dictionary")
    Set Dic.FA = CreateObject("Scripting.Dictionary")
   
    arr = Tabelle2.Range("A1").CurrentRegion 'Anpassen Quelle *******
   
    For i = 1 To UBound(arr)
        If arr(i, 2) <> 0 Then
            krit = arr(i, 1) & arr(i, 2)
            Dic.Datum(krit) = arr(i, 1)
            Dic.Schicht(krit) = arr(i, 2)
            Dic.Gutteile(krit) = Dic.Gutteile(krit) + arr(i, 3)
            Dic.Ausschuss(krit) = Dic.Ausschuss(krit) + arr(i, 4)
            Dic.Artikel(krit) = arr(i, 5)
            Dic.FA(krit) = arr(i, 6)
        End If
    Next
   
    With Tabelle3 'Anpassen Ziel *************************************
        .Range("A1").CurrentRegion.Clear
       
        .Range("A1").Resize(Dic.Datum.Count) = _
        WorksheetFunction.Transpose(Dic.Datum.Items)
        .Range("B1").Resize(Dic.Schicht.Count) = _
        WorksheetFunction.Transpose(Dic.Schicht.Items)
        .Range("C1").Resize(Dic.Gutteile.Count) = _
        WorksheetFunction.Transpose(Dic.Gutteile.Items)
        .Range("D1").Resize(Dic.Ausschuss.Count) = _
        WorksheetFunction.Transpose(Dic.Ausschuss.Items)
        .Range("E1").Resize(Dic.Artikel.Count) = _
        WorksheetFunction.Transpose(Dic.Artikel.Items)
        .Range("F1").Resize(Dic.FA.Count) = _
        WorksheetFunction.Transpose(Dic.FA.Items)
       
        With .Range("A1").CurrentRegion
            .Sort .Cells(1), xlAscending, .Cells(2), , xlAscending, Header:=xlYes
        End With
    End With
   
End Sub






Funzt soweit ganz gut, nur sollte eben bei unter FA immer derjenige auftauchen, bei dem die meisten Gutteile zu verbuchen sind. Z.B. 26.09.10 Schicht 3, FA 2010003030 und nicht 2010003032. Kann man das noch ins Makro mit einbauen?



Auswertung_1.xls
 Beschreibung:
Mit Office 2007 erstellt, in der Arbeit arbeite ich jedoch mit Office 2003

Download
 Dateiname:  Auswertung_1.xls
 Dateigröße:  44 KB
 Heruntergeladen:  26 mal

Phelan XLPH
Fortgeschritten


Verfasst am:
27. Sep 2010, 20:50
Rufname: Phelan

AW: Hilfe bei Maschinen-Schichtdatenauswertung - AW: Hilfe bei Maschinen-Schichtdatenauswertung

Nach oben
       Version: Office 2003

Hallo,

Code:
Option Explicit

Private Type SchichtDaten
    Datum       As Object
    Schicht     As Object
    Gutteile    As Object
    Ausschuss   As Object
    Artikel     As Object
    FA          As Object
    FA_maxGutt  As Object
End Type

Public Dic As SchichtDaten

Sub SchichtDaten_Auswerten()
    Dim arr     As Variant
    Dim arrTmp  As Variant
    Dim MaxPos  As Variant
    Dim i       As Long
    Dim krit    As String
    Dim MaxGutteile As Double
    Set Dic.Datum = CreateObject("Scripting.Dictionary")
    Set Dic.Schicht = CreateObject("Scripting.Dictionary")
    Set Dic.Gutteile = CreateObject("Scripting.Dictionary")
    Set Dic.Ausschuss = CreateObject("Scripting.Dictionary")
    Set Dic.Artikel = CreateObject("Scripting.Dictionary")
    Set Dic.FA = CreateObject("Scripting.Dictionary")
    Set Dic.FA_maxGutt = CreateObject("Scripting.Dictionary")
   
    arr = Tabelle2.Range("A1").CurrentRegion 'Anpassen Quelle *******
   
    For i = 1 To UBound(arr)
        If arr(i, 2) <> 0 Then
            krit = arr(i, 1) & arr(i, 2)
            Dic.Datum(krit) = arr(i, 1)
            Dic.Schicht(krit) = arr(i, 2)
            Dic.Gutteile(krit) = Dic.Gutteile(krit) + arr(i, 3)
            Dic.Ausschuss(krit) = Dic.Ausschuss(krit) + arr(i, 4)
            Dic.Artikel(krit) = arr(i, 5)
           
            If i > 1 Then
                If Not Dic.FA_maxGutt.Exists(krit) _
                Then Dic.FA_maxGutt(krit) = 0
                If Dic.FA_maxGutt(krit) <= arr(i, 3) Then
                    Dic.FA_maxGutt(krit) = arr(i, 3)
                    Dic.FA(krit) = arr(i, 6)
                End If
            Else
                Dic.FA(krit) = arr(i, 6)
            End If
        End If
    Next
   
    With Tabelle3 'Anpassen Ziel *************************************
        .Range("A1").CurrentRegion.Clear
       
        .Range("A1").Resize(Dic.Datum.Count) = _
        WorksheetFunction.Transpose(Dic.Datum.Items)
        .Range("B1").Resize(Dic.Schicht.Count) = _
        WorksheetFunction.Transpose(Dic.Schicht.Items)
        .Range("C1").Resize(Dic.Gutteile.Count) = _
        WorksheetFunction.Transpose(Dic.Gutteile.Items)
        .Range("D1").Resize(Dic.Ausschuss.Count) = _
        WorksheetFunction.Transpose(Dic.Ausschuss.Items)
        .Range("E1").Resize(Dic.Artikel.Count) = _
        WorksheetFunction.Transpose(Dic.Artikel.Items)
        .Range("F1").Resize(Dic.FA.Count) = _
        WorksheetFunction.Transpose(Dic.FA.Items)
       
        With .Range("A1").CurrentRegion
            .Sort .Cells(1), xlAscending, .Cells(2), , xlAscending, Header:=xlYes
        End With
    End With
   
End Sub

_________________
Was vorstellbar ist, ist auch machbar. - Albert Einstein
Pscht2010
Einsteiger


Verfasst am:
27. Sep 2010, 22:17
Rufname:


AW: Hilfe bei Maschinen-Schichtdatenauswertung - AW: Hilfe bei Maschinen-Schichtdatenauswertung

Nach oben
       Version: Office 2003

Habs gerade getestet, funktioniert super! Rückmeldung unter realen Bedingungen (in der Arbeit) folgt!

Tausend Dank!
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: JavaScript