VBA sortieren nur nach einem Muster

[thomasw1]

Guten morgen an alle,
ich muss aus diversen Mappen Daten verarbeiten und zu einer Auswertung zusammensetzen,
wie es nun leider so ist sind diese Daten von verschieden Kollegen, und jeder hat sein eigenes System für seine Übersicht.
Ich habe nun mit diversen Routinen und Abfragen die für mich relevanten Teile automatisch in meine Mappe
kopiern und für mich auch aufarbeiten können, doch nun bin ich am Ende meines Lateins und der von MR.Google.

Mit Macrorekorder augezeichnet

Code:

Sheets("Tabelle2").Activate
Range("A5:B21").Select
Selection.AutoFilter
ActiveSheet.Range("$A$5:$B$21").AutoFilter Field:=1, Criteria1:=Array( _
"0012-W-335 1x", "0012-W-341 1x", "0012-W-342 1x", "0012-W-368 1x", "0017-W-445 2x" _
, "0017-W-470 2x"), Operator:=xlFilterValues

wird das was ich nicht will schön rausgefiltert.
Nun ist es aber so das sich diese Nummern ändern können in der nächsten KW.
Also will ich Filtern nach einem Muster, ähnlich wie bei der Formatierung einer Zelle
"####-W-###" oder "00##-W-###".
Gibt es da irgend etwas oder hier einen "CODE-KNACKER" der mir den Skriptansatz schreiben kann?

In Anlage ein kleines Musterbeispiel Tabelle 1 meine Urdaten, Tabelle2 so sollte es aussehen, nach einer Kopier, .... Funktion.

Dies muss in ein anderes Tabellenblatt gebracht werden, da dies in einer anderen Mappe zur nachträglichen Begutachtung gespeichert wird.

Danke für die Mühe @ All und einen Guten Rutsch
Thomas

[Phi.VBA]

Hallo,

wenn ich das richtig verstanden habe, wird in zweiten Teil "Hermle 2" die Bezeichnung in der zweiten Zeile weggelassen. Dies kann mit einem speziellen Code korrigiert werden, aber eben nur für diesen Mitarbeiter.

Filtern nach "enthält -W-" in immer möglich, geht aber nur, nachdem die genannten Varianten korrigiert sind.

Vorschlag: die Mitarbeiter besser zu trainieren, den keine Makrolösung kann alle (wechselnden) Varianten erfassen.

Grüße

(es gibt sicher noch weitere Meinungen/Vorschläge)

[thomasw1]

moin Phi.VBA,
thx für deine schnelle Antwort, aber das zu

Vorschlag: die Mitarbeiter besser zu trainieren,

ist nunmal nicht so einfach.
Altersunterschiede z.B, extrem Umfangreiche Excel-Tabellen (von ca 2M bis zu ca.16MB größe), seine Übersicht ist Verständlich da es um eine Schicht-/Auftragsplanung mit Zeitvorgabe der Maschinenbelegung handelt(2 Schichten mit 9 Maschinen)
Diese Nummern sind Interne Teilenummern mit denen ich nacher auch in der Textfarbe weiterarbeiten muss. Es sind optsche Anzeigen für
den Status Material vorhanden/bestellt, Werkstück programmiert/nicht Programmiert, Dringlichkeit, ......
Dann müssen diese Teile eventuell über mehrer Maschinen wegen Ihrer komplexität oder Maßhaltigkeit.
Deshalb ist z.B. 0014-W-068 2x mit 1.Spannung 24,94h und 2.Spannung 18,17h eingeplant.

Mein Ansatzt habe ich beim Schreiben des 1. Textes nochmal überlegt und kam drauf es mit
In Tabelle1 Range A4:A23
Wenn in Tabelle1 Zelle A4 "-W-" enthalten ist kopiere A4 und B4 nach Tabelle2 A3 und B3, wenn nicht/bzw. Fehler gehe zu A5
Wenn in Tabelle1 Zelle A5 "-W-" enthalten ist kopiere A5 und B5 nach Tabelle2 A3 und B3, wenn nicht/bzw. Fehler gehe zu A6 (wahr-> kopiert)
Wenn in Tabelle1 Zelle A6 "-W-" enthalten ist kopiere A5 und B5 nach Tabelle2 A4 und B4, wenn nicht/bzw. Fehler gehe zu A7 (wahr-> kopiert)

Ich will ja nur die Teilenummer mit der Zeit kopieren, leere Zelle oder andere Texte ignorieren da mit Errorhandel geblockt.

Mal sehen wie weit ich damit komme.

[thomasw1]

Guten Morgen @ all,
habs geschaft ist zwar nicht die sauberste Lösung aber es geht.
Wollte es gerne mit einer For i oder Do Variante lösen nur mit der For i zählte er nach dem Fehler nicht richtig,
und mit Do Variante auch nicht in der lief er nur 1 mal durch oder zählte gar nicht bzw. unendlich weiß der Geier warum .
Eventuell gibt es doch eine bessere Variante mal sehen .

Code:

Private Sub CommandButton1_Click()
'****  Maschine 1 KW 1
' Variblen definieren
   Dim M1MWNRsu As Variant
   Dim M1SuZeile1 As Long
   Dim M1SuSpalte2 As Long
   Dim M1Zeilenzähler As Long
   Dim M1Zähler As Long
   Dim Startzeile As Long
   Dim M1X As Integer
' Variblen füllen werden in meiner Mappe nach Berechnungen aussgelesen
   M1SuSpalte1 = 1
   M1MWNRsu = "-w-"
   M1Zähler = 4
   M1SuSpalte2 = M1SuSpalte1 + 1
   M1Zeilenzähler = 4


Worksheets("Tabelle1").Activate

'Routine mit Zähler

M1NuNochmal:
       Range("A" & M1Zeilenzähler).Select
       On Error GoTo M1MistLeer
       M1SuZeile1 = Selection.Find(What:=M1MWNRsu, After:=ActiveCell, SearchFormat:=True).Row
           If M1SuZeile1 > 0 Then
               Worksheets("Tabelle1").Cells(M1SuZeile1, M1SuSpalte1).Copy Worksheets("Tabelle2").Range("E" & M1Zähler)
               Worksheets("Tabelle1").Cells(M1SuZeile1, M1SuSpalte2).Copy Worksheets("Tabelle2").Range("F" & M1Zähler)
               M1Zeilenzähler = M1Zeilenzähler + 1
               M1Zähler = M1Zähler + 1
           End If

       'Zähler mit  späterem Sortieren 
       M1X = M1X + 1
       If M1X = 19 Then
               Range("E4:F21").Select
               ActiveWorkbook.Worksheets("Tabelle2").Sort.SortFields.Clear
               ActiveWorkbook.Worksheets("Tabelle2").Sort.SortFields.Add Key:=Range("E4"), _
               SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
               xlSortTextAsNumbers
               With ActiveWorkbook.Worksheets("Tabelle2").Sort
                   .SetRange Range("E4:F21")
                   .Header = xlNo
                   .MatchCase = False
                   .Orientation = xlTopToBottom
                   .SortMethod = xlPinYin
                   .Apply
               End With
           GoTo Maschine2KW1
       End If
       
GoTo M1NuNochmal

'Fehler Sprungmarke 1
M1MistLeer:
   M1Zeilenzähler = M1Zeilenzähler + 1
 
   M1X = M1X + 1
       If M1X = 19 Then
           Exit Sub
       End If
   Resume M1NuNochmal

End Sub
   

Guten Rutsch und ein Gesundes Neues Jahr 2018
Thomas

[Elex]

Hi

wäre denn der Spezialfilter nicht eine einfache und flexible Lösung für dein Problem.