Office: FIND und FINDNEXT Problem

Hallo,

ich habe ein Problem mit dem Find und Findnext.
Ich möchte den Wert in Spalte D und Zeile x suchen, allerdings darf in der erste gefundene Eintrag nicht die Ausgangszelle sein und dann ein "Hallo" jedes mal ausgeben, sobald er den Wert mit Findnext wieder gefunden hat. Ausserdem darf er bei jedem Schleifendurchlauf nicht wieder ganz oben anfangen zu suchen, sondern erst nach der Zeile in der er sich jetzt befindet und dann wieder ein Hallo ausgeben. In meinem Beispiel müssten es dann 5x ein Hallo geben und nicht mehr oder weniger. Leider funktioniert es nicht mit meinem Code. Anbei auch das File.

Vielen Dank für die Hilfe im Voraus *wink.gif*.



Code:

:)

 

Hallo Armado,

worauf soll das Ganze hinauslaufen?

 

ich möchte dann das hallo ersetzen und jede gefundene zeile dann unter gewissen Bedingungen aufaddieren. sprich spalte G addiere ich dann, wenn spalte D und spalte A und Spalte B gleich ist, aber in Spalte C nicht das Wort "SK" oder "SV" vorkommt. Verstehst du was ich meine ? und danach die zeilen löschen. im Prinzip so, dass ich alles was die Bedingungen erfüllt dann zusammenrechnet und nur noch eine zeile dafür übrig bleibt mit dem Gesamtwert.

 

oder würdest du es anders lösen?

 

Hallo,

vielleicht kann man das auch anders lösen. Ich denke rein von dem logischen Ansatz her müsste das Makro so funktionieren.

1. Von der letzten Zeile ausgehend
2. Prüfen, ob der Wert in Spalte 4 der letzten Zeile in irgendeiner Zelle oberhalb auch vorhanden ist und in Spalte 1, Spalte 2 der gleiche Wert enthalten ist, aber in Spalte 3 nicht das Wort SK oder SV enthalten ist.
3. Wenn das der Fall ist müssen die Werte in Spalte 7 addiert werden und
4. Die Werte der Spalten 3 und 6 verkettet werden
5. Das Ergebnis in einer Zeile speichern und alle anderen Zeilen, die die Grundlage der Berechnung war, müssen gelöscht werden.

Ist das verständlich?

Danke für die Hilfe

 

Hier mal ein Vorher und Nachher Bild

 

Hallo Armado,

sorry, hat ein bisschen gedauert ich wollte es aber so schreiben dass du noch eine Chance hast den Code zu verstehen.

Option Explicit

Public Sub Aufbereitung()

Dim avntValues As Variant, avntKeys As Variant
Dim strFirstAddress As String, strKey As String
Dim ialngIndex As Long, ialngRow As Long, ialngRange As Long
Dim objDictionary As Object
Dim objCell As Range, aobjRange() As Range, objDelRows As Range

'Tabelle einlesen
avntValues = Range(Cells(2, 1), Cells(Rows.Count, 4).End(xlUp)).Value2

'Dictionary-Klasse instanziieren
Set objDictionary = CreateObject(Class:="Scripting.Dictionary")

'Schleife über das Array
For ialngIndex = 1 To UBound(avntValues, 1)

'Wenn sich in Spalte D ein Wert befindet
If Not IsEmpty(avntValues(ialngIndex, 4)) Then

If avntValues(ialngIndex, 3) <> "SK" Then

If avntValues(ialngIndex, 3) <> "SV" Then

'Schlüssel bilden
strKey = avntValues(ialngIndex, 1) & "|" & _
avntValues(ialngIndex, 2) & "|" & avntValues(ialngIndex, 4)

'Wenn es den Schlüssel schon gibt
If objDictionary.Exists(strKey) Then

'1 zum Schlüssel hinzuaddieren
objDictionary(strKey) = objDictionary(strKey) + 1

Else

'Schlüssel kommt zum 1. Mal vor
objDictionary(strKey) = 1

End If
End If
End If
End If
Next

'Schlüssel und Werte an Arrays übergeben
avntKeys = objDictionary.Keys
avntValues = objDictionary.Items

'Dictionary-Klasse zerstören
Set objDictionary = Nothing

With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With

'Schleife über die Werte
For ialngIndex = 0 To UBound(avntValues, 1)

'Wenn der Schlüssel öfters als einmal vorgekommen ist
If avntValues(ialngIndex) > 1 Then

'Schlüssel suchen
Redim objRange(1 To avntValues(ialngIndex))
ialngRange = 0
Set objCell = Columns(4).Find(What:=Split(avntKeys(ialngIndex), "|")(2), _
After:=Cells(1, 4), LookIn:=xlValues, LookAt:=xlWhole)
strFirstAddress = objCell.Address
Do
If objCell.Offset(0, -3).Value = Split(avntKeys(ialngIndex), "|")(0) Then
If objCell.Offset(0, -2).Value = CDate(Split(avntKeys(ialngIndex), "|")(1)) Then
With objCell.Offset(0, -1)
If .Value <> "SK" Then
If .Value <> "SV" Then
ialngRange = ialngRange + 1
Set objRange(ialngRange) = objCell
End If
End If
End With
End If
End If
Set objCell = Columns(4).FindNext(After:=objCell)
Loop Until strFirstAddress = objCell.Address
Set objCell = Nothing

'Schleife über die gefundenen Schlüssel
For ialngRow = 2 To ialngRange

'Zeilen die gelöscht werden sollen sammeln
If objDelRows Is Nothing Then Set objDelRows = objRange(ialngRow) Else _
Set objDelRows = Union(objDelRows, objRange(ialngRow))

'Werte in Spalte 3 zusammenbauen
objRange(1).Offset(0, -1).Value = objRange(1).Offset(0, -1).Value & _
", " & objRange(ialngRow).Offset(0, -1).Value

'Werte in Spalte 6 zusammenbauen
objRange(1).Offset(0, 2).Value = objRange(1).Offset(0, 2).Value & _
", " & objRange(ialngRow).Offset(0, 2).Value

'Werte in Spalte 7 addieren
objRange(1).Offset(0, 3).Value = objRange(1).Offset(0, 3).Value + _
objRange(ialngRow).Offset(0, 3).Value

Next
Erase aobjRange
End If
Next

'Überflüssig gewordene Zeilen löschen
If Not objDelRows Is Nothing Then Call objDelRows.EntireRow.Delete

With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

 

Absolut kein Problem, jetzt war ich eine Zeit lang nicht da. Danke dir das ist ja absolut der Hammer !!!!!!! Top *wink.gif* Danke!