VBA: letzte Einträge suchen

Anja_81a2c3 · 11. November 2019 um 19:40

Hallo,

ich versuche gerade wieder einmal ein Makro zu programmieren und scheitere kläglich. Ich benutzte Excel 2007 und VB 6.5.
Also, folgende Situation:

Ich habe eine Tabelle, in der in der ersten Spalte verschiedene Maschinen drinstehen, in der zweiten Spalte verschiedene Daten und in der dritten eine 1 (ist durchgelaufen) oder eine 0 (ist ausgefallen).
Es gibt 30 verschiedene Maschinen und für jede Maschine 80 verschiedene Daten, die alle untereinander stehen.

Drehen |1.12.|1
Drehen |2.12.|0
Drehen |3.12.|0
Drehen |4.12.|0
Drehen |5.12.|1
Drehen |16.12.
Drehen |17.12.
Fluxen |2.12.|1
Fluxen |4.12.|0
Fluxen |6.12.|1
Fluxen |8.12.|1
Fluxen |10.12.|1
Fluxen |12.12.|0
Fluxen |14.12.|0
Fluxen| 16.12|

Ich möchte nun in einer anderen Tabelle für die letzten vier Daten jeder Maschine die Anzahl der Einsen und Nullen ermitteln.

Das gewünschte Ergebnis wäre also im Beispiel: Drehen: 3 * 0 und 1 * 1 und beim Fluxen 2 * 0 und 2 * 1.

Wenn dann am 16.12 die neuen Ergebnisse für die Maschinen eingetragen werden, dann darf bei der Berechnung natürlich das Ergebnis vom 2.12 beim Drehen und vom 8.12 beim Fluxen nicht mehr mitbetrachtet werden, da sie dann ja das fünft-letzte Datum sind.
Gibt es die Möglichkeit, dies über ein Makro abzubilden? Ich kriege es hin, wenn ich die letzten vier Daten manuell markiere, aber ich weiß nicht, wie ich per Makro diese Markierung hinbekomme.

Als zweites wäre es toll, wenn ich eine Art „Strähne“ oder Serie angeben könnte.
In meinem Beispiel wäre beim Drehen die Strähne 1 * 1 und beim Fluxen 2 * 0.

Hat irgendjemand Ideen?

Danke und Grüße Anja

Reinhard_fb8cb7 · 11. November 2019 um 19:40

Hallo Anja,

ich versuche gerade wieder einmal ein Makro zu programmieren
und scheitere kläglich. Ich benutzte Excel 2007 und VB 6.5.
Also, folgende Situation:

Lasse VB6.5 weg, Excel2007-Vba reicht.
(In reinen VB-Foren können sie mit VB6.5 nix anfangen wenn sie kein Office haben)

Gibt es die Möglichkeit, dies über ein Makro abzubilden? Ich
kriege es hin, wenn ich die letzten vier Daten manuell
markiere, aber ich weiß nicht, wie ich per Makro diese
Markierung hinbekomme.

was willst du nun, in einem zweiten Blatt Ergebisse pro Maschine, oder im ersten Blatt jeweis die letzten 4 markieren, gleiche farbe für alle? Oder beides?

Als zweites wäre es toll, wenn ich eine Art „Strähne“ oder
Serie angeben könnte.
In meinem Beispiel wäre beim Drehen die Strähne 1 * 1 und beim
Fluxen 2 * 0.

Bastle dir ein zweites Blatt, hier tabelle2:

Tabellenblatt: [Mappe2]!Tabelle2
 │ A │ B │ C │
──┼──────────┼─────────┼─────────┤
1 │ Maschine │ letzte4 │ Tendenz │
──┼──────────┼─────────┼─────────┤
2 │ Drehen │ 0001 │ 1 │
──┼──────────┼─────────┼─────────┤
3 │ Fluxen │ 1100 │ 00 │
──┴──────────┴─────────┴─────────┘

Nachfolgender erster Code gehört in ein Standardmodul,z.B. Modul1
Stell dich dann dort mit dem Curser in den Code und drücke F5.

Falls der Code nicht läuft, checke ob du Leerzeichen nach den Maschinennamen stehen hast.
Dauert er viel zulange, er birgt noch genug Tuningmöglichkeiten.
Der zweite Code gehört ins Modul von Tabelle1
Er ruft dann von sich aus den ersten Code automatisch auf wenn du in Spalte C von Tabelle1 was eingibst

Gruß
Reinhard

Option Explicit
'
Sub Vier\_Gewinnt()
Dim Zei1 As Long, Zei2 As Long, wks1 As Worksheet, wks2 As Worksheet
Dim Z1 As Long, Letzte4 As String, Trend As String
Set wks1 = Worksheets("Tabelle1")
Set wks2 = Worksheets("Tabelle2")
wks2.Range("B:C").NumberFormat = "@"
Application.ScreenUpdating = False
With wks1
 Zei1 = .Cells(Rows.Count, 1).End(xlUp).Row
 For Zei2 = 2 To wks2.Cells(Rows.Count, 1).End(xlUp).Row
 Letzte4 = ""
 Trend = ""
 Z1 = Zei1
 Do
 If .Cells(Z1, 1) = wks2.Cells(Zei2, 1) Then
 If .Cells(Z1, 3) "" Then
 Letzte4 = CStr(.Cells(Z1, 3)) & Letzte4
 End If
 End If
 Z1 = Z1 - 1
 Loop While Len(Letzte4) 0
 wks2.Cells(Zei2, 2) = Letzte4
 If Letzte4 "" Then
 Trend = Right(Letzte4, 1)
 Z1 = 3
 While Z1 \> 0
 If Mid(Letzte4, Z1, 1) = Right(Letzte4, 1) Then
 Trend = Mid(Letzte4, Z1, 1) & Trend
 Else
 Z1 = 0
 End If
 Z1 = Z1 - 1
 Wend
 End If
 wks2.Cells(Zei2, 3) = Trend
 Next Zei2
End With
Application.ScreenUpdating = True
End Sub

Ins Klassenmodul „Tabelle1“

Option Explicit
'
Private Sub Worksheet\_Change(ByVal Target As Range)
If Target.Column 3 Then Exit Sub
If Target.Cells.Count 1 Then Exit Sub
Call Vier\_Gewinnt
End Sub

Anja_81a2c3 · 11. November 2019 um 19:41

Hallo Reinhard,

was willst du nun, in einem zweiten Blatt Ergebisse pro
Maschine, oder im ersten Blatt jeweis die letzten 4 markieren,
gleiche farbe für alle? Oder beides?

Als Endergebnis möchte ich die Ergebnisse auf einem zweiten Blatt.

Wollte aber sagen, dass ich einen Teil meines Ziel bereits selbstständig erreichen kann und das mir für meine Lösung der Start fehlt. Dieser besteht in der „Markierung“ der letzten vier Daten. Die Markierung müsste so aussehen, dass in der vierten Spalte neben den letzten vier Daten ein „x“ oder was auch immer steht.

Deinen anderen Vorschlag werde ich gleich bei mir versuchen einzubauchen.

Vielen Dank schon einmal
Anja

Anja_81a2c3 · 11. November 2019 um 19:42

Hallo,

habe deine Lösung inzwischen in meine Tabelle integriert und das mit den letzten4 läuft auch super, aber bei der Tendenz sind einige Fehler drin.
Bei circa der Hälfte der Maschinen kommt das richtige Ergebnis, bei der anderen Hälfte ein falsches.
Habe bis jetzt kein Muster erkannt.

Hast du spontan eine Idee, wonach ich noch einmal schauen könnte?

Danke und Grüße
Anja

Reinhard_fb8cb7 · 11. November 2019 um 19:42

habe deine Lösung inzwischen in meine Tabelle integriert und
das mit den letzten4 läuft auch super, aber bei der Tendenz
sind einige Fehler drin.
Bei circa der Hälfte der Maschinen kommt das richtige
Ergebnis, bei der anderen Hälfte ein falsches.
Habe bis jetzt kein Muster erkannt.

Hast du spontan eine Idee, wonach ich noch einmal schauen
könnte?

Hallo Anja,

es wäre sehr hilfreich wenn ich genau den Fehler sehen würde.
Kopiere von Blatt2 Spalte B + C in eine neue mappe und lade die hoch mit file-upload, s. FAQ:2606

Ist die Schnelligkeit des Makros i.O.?

Gruß
Reinhard

Reinhard_fb8cb7 · 11. November 2019 um 19:42

Wollte aber sagen, dass ich einen Teil meines Ziel bereits
selbstständig erreichen kann und das mir für meine Lösung der
Start fehlt. Dieser besteht in der „Markierung“ der letzten
vier Daten. Die Markierung müsste so aussehen, dass in der
vierten Spalte neben den letzten vier Daten ein „x“ oder was
auch immer steht.

Hallo Anja,

ich habe meinen Code erweitert, zum Einen wird in Spalte D nun ein X angezeigt bei den letzten 4.
Zum anderen die letzten 4 im Bereich A:C farblich markiert.

Wenn du eines davon nicht brauchst, so lösche die entsprechenden Codezeilen.
Gefärbt wird mit zwei Zeilen, erkennbar am „Interior.ColorIndex“ in der Codezeile.
Ge"X"t wird in drei Zeilen in Spalte D, erkennbar an der „4“ in der codezeile, wie bei ".Cells(1, 4 ) = „Letzt4“.
Oder die 4 abändern, wenn du nicht D sondern eine andere Spalte haben willst/mußt.

Äh, Diese Änderung der Spalte D MU?T du machen BEVOR du den Code startest, denn der Code löscht (im Moment) unwiederbringlich alles in Spalte D und schreibt dann die Xe rein.

Gruß
Reinhard

Option Explicit
'
Sub Vier\_Gewinnt()
Dim Zei1 As Long, Zei2 As Long, wks1 As Worksheet, wks2 As Worksheet
Dim Z1 As Long, Letzte4 As String, Trend As String
Set wks1 = Worksheets("Tabelle1")
Set wks2 = Worksheets("Tabelle2")
wks2.Range("B:C").NumberFormat = "@"
Application.ScreenUpdating = False
With wks1
 .Range("A:C").Interior.ColorIndex = xlNone
 .Columns(4).ClearContents
 .Cells(1, 4) = "Letzt4"
 Zei1 = .Cells(Rows.Count, 1).End(xlUp).Row
 For Zei2 = 2 To wks2.Cells(Rows.Count, 1).End(xlUp).Row
 Letzte4 = ""
 Trend = ""
 Z1 = Zei1
 Do
 If .Cells(Z1, 1) = wks2.Cells(Zei2, 1) Then
 If .Cells(Z1, 3) "" Then
 Letzte4 = CStr(.Cells(Z1, 3)) & Letzte4
 .Cells(Z1, 4) = "X"
 .Range("A" & Z1 & ":C" & Z1).Interior.ColorIndex = 34
 End If
 End If
 Z1 = Z1 - 1
 Loop While Len(Letzte4) 0
 wks2.Cells(Zei2, 2) = Letzte4
 If Letzte4 "" Then
 Trend = Right(Letzte4, 1)
 Z1 = 3
 While Z1 \> 0
 If Mid(Letzte4, Z1, 1) = Right(Letzte4, 1) Then
 Trend = Mid(Letzte4, Z1, 1) & Trend
 Else
 Z1 = 0
 End If
 Z1 = Z1 - 1
 Wend
 End If
 wks2.Cells(Zei2, 3) = Trend
 Next Zei2
End With
Application.ScreenUpdating = True
End Sub

Anja_81a2c3 · 11. November 2019 um 19:44

Hallo Reinhard,

hier der Link für die Originaldatei:

http://www.file-upload.net/download-3053583/Maschine…

Am Tempo der Makro kann ich nichts beanstanden.

Danke und Grüße
Anja

Reinhard_fb8cb7 · 11. November 2019 um 19:44

http://www.file-upload.net/download-3053583/Maschine…

Hallo Anja,

ändere bitte im Code

Z1=3
auf
Z1=9

Ansonsten habe ich meinen Code genommen wie er ist und laufen lassen.
Tendenz sieht doch völlig korrekt aus:
http://www.image-load.net/page.php?type=jpg&f=a3ad1c…

Kriegste das Markieren der jeweils letzten10 in Tabelle1 hin?
Wenn nicht melde dich und sage wie markiert werden soll, Farbe, Xe…

Gruß
Reinhard

Anja_81a2c3 · 11. November 2019 um 19:47

Hallo,

super, vielen Dank.

Das mit dem Markieren brauche ich nicht mehr. Ich ziehe mir die notwendigen Informationen aus deiner Spalte „Letzte10“.

Du hast mir echt geholfen. Nochmal vielen Dank

Grüße Anja