Wert in Bereich finden

Bild

Betrifft: Wert in Bereich finden von: Melanie
Geschrieben am: 17.02.2005 19:08:13

Hallo zusammen!

Ich brauche an meinem Makro noch den letzten Feinschliff und komme irgendwie nicht auf den richtigen Gedanken.... Sicher könnt ihr mir helfen.

Es geht um eine Artikeldatei, die laufend fortgeschrieben wird. Ich würde gerne überprüfen, ob der Artikel weiter oben schon mal eingegeben wurde. Dann soll
1. in Spalte S der Hinweis "doppelt" stehen und
2. in Spalte AD der Wert stehen, der in der Spalte AD ist, wo der Artikel zuerst vorkommt.

Ich denke mal, dass der Code ziemlich umständlich geschrieben ist, weil ich erst vor kurzem mit VBA angefangen habe. Vielleicht könnt ihr trotzdem helfen.
Ich habe in den letzten beiden Zeilen der Datei ein Beispiel gemacht, wie ich es gerne erreichen würde.

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

Danke schon mal vorab!!
Gruß,
Melanie



Option Explicit

Sub Schrottliste()
Dim i As Integer
Dim iRow As Integer
Dim iRowL As Integer
Dim wkbQuelle4 As Workbook
Dim wkbQuelle6 As Workbook
Dim wkbBasis As Workbook
Dim wksBasis As Worksheet
Dim bereich As Range
 
Set wkbBasis = ActiveWorkbook
Set wksBasis = wkbBasis.Worksheets("Tabelle1")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wkbQuelle4 = Workbooks.Open("M:\Werk7WorkingCapital\Projektcontrolling\Gesamtbestand-aktuell.xls")
Set wkbQuelle6 = Workbooks.Open("M:\et-p\Materialstamm ET\MatStamm-aktuell.xls")
Workbooks("Schrottliste (3).xls").Sheets("Tabelle1").Activate
If IsEmpty(Cells(2, 3)) Then
    iRow = 2
Else
    iRow = Cells(Rows.Count, 3).End(xlUp).Row + 1
End If
iRowL = ActiveSheet.UsedRange.Rows.Count
Columns(8).NumberFormat = "dd.mm.yyyy"
On Error Resume Next
For i = iRow To iRowL
wksBasis.Cells(i, 3) = Date
wksBasis.Cells(i, 3).NumberFormat = "dd.mm.yyyy"
'Wenn Cells(i,1) leer ist, dann gehe nimm als Verweis Cells(i, 2), ansonsten cells(i,1)
****Hier soll die Prüfung rein:
Wenn der Wert von wksBasis.Cells(i,2) im Bereich iRow bis i-1, Spalte 2 enthalten ist, dann soll in Cells (i,19) "doppelt" stehen und in Cells (i, 30) der Wert der Spalte (?, 30) stehen, dann über next ins nächste i springen ***
If IsEmpty(wksBasis.Cells(i, 1)) Then
wksBasis.Cells(i, 4) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 6, False) 'Disp.Nrn
wksBasis.Cells(i, 5) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 5, False) 'disponenten
wksBasis.Cells(i, 28).Value = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 44, False) 'Versorgungsende LC
If Cells(i, 28).Value = "00.00.0000" Then
Cells(i, 6).Value = "00.00.0000"
Cells(i, 6).Font.ColorIndex = xlAutomatic
Else
Cells(i, 6).Value = "=DATEVALUE(RC[22])"
Cells(i, 6).NumberFormat = "dd.mm.yyyy"
    If Cells(i, 6).Value < Date Then
    Cells(i, 6).Font.ColorIndex = 3
    Else
    Cells(i, 6).Font.ColorIndex = xlAutomatic
    End If
End If
wksBasis.Cells(i, 7).FormulaR1C1 = "=RC[3]/((RC[6]*0.2)+(RC[7]*0.3)+(RC[8]*0.5))*12"
wksBasis.Cells(i, 7).NumberFormat = "0"
wksBasis.Cells(i, 8).FormulaR1C1 = "=TODAY() + (RC[-1]/12*365)"
wksBasis.Cells(i, 9).FormulaR1C1 = "=IF(RC[-3]=""00.00.0000"",""Prüfung durch Technik"",IF(RC[-1]>RC[-3],""J"",""N""))"
Cells(i, 9).Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""J"""
    Selection.FormatConditions(1).Font.ColorIndex = 3
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
        Formula1:="=""J"""
    Selection.FormatConditions(2).Font.ColorIndex = xlAutomatic
    
wksBasis.Cells(i, 10) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("Gesamtbestand ohne Sonderläger"). _
Range("A1:Q35000"), 16, False) 'Menge
wksBasis.Cells(i, 11) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("gesamtbestand"). _
Range("A1:M35000"), 13, False) 'Preis lt. Steuerung
wksBasis.Cells(i, 12) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("Gesamtbestand ohne Sonderläger"). _
Range("A1:Q35000"), 17, False) 'Wert Lagerbestand
wksBasis.Cells(i, 13) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 13, False) 'Verbrauch 2002
wksBasis.Cells(i, 14) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 14, False) 'Verbrauch 2003
wksBasis.Cells(i, 15) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 15, False) 'Verbrauch 2004
wksBasis.Cells(i, 16) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 8, False) 'VStati Inland
wksBasis.Cells(i, 17) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 9, False) 'VStati Export
wksBasis.Cells(i, 18) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 10, False) 'VStati TG
wksBasis.Cells(i, 21).FormulaR1C1 = "=RC[-1]/100*RC[-10]"
wksBasis.Cells(i, 23) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("2120"). _
Range("A1:Q35000"), 12, False) 'Bestand 2120
wksBasis.Cells(i, 24) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("2140"). _
Range("A1:Q35000"), 12, False) 'Bestand 2140
wksBasis.Cells(i, 25) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("2145"). _
Range("A1:Q35000"), 12, False) 'Bestand 2145
wksBasis.Cells(i, 26) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("2185"). _
Range("A1:Q35000"), 12, False) 'Bestand 2185
wksBasis.Cells(i, 27) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("5000"). _
Range("A1:Q35000"), 12, False) 'Bestand 5000
Else
wksBasis.Cells(i, 4) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 6, False) 'Disp.Nrn
wksBasis.Cells(i, 5) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 5, False) 'disponenten
wksBasis.Cells(i, 28).Value = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 44, False) 'Versorgungsende LC
If Cells(i, 28).Value = "00.00.0000" Then
Cells(i, 6).Value = "00.00.0000"
Cells(i, 6).Font.ColorIndex = xlAutomatic
Else
Cells(i, 6).Value = "=DATEVALUE(RC[22])"
Cells(i, 6).NumberFormat = "dd.mm.yyyy"
    If Cells(i, 6).Value < Date Then
    Cells(i, 6).Font.ColorIndex = 3
    Else
    Cells(i, 6).Font.ColorIndex = xlAutomatic
    End If
End If
wksBasis.Cells(i, 7).FormulaR1C1 = "=RC[3]/((RC[6]*0.2)+(RC[7]*0.3)+(RC[8]*0.5))*12"
wksBasis.Cells(i, 7).NumberFormat = "0"
wksBasis.Cells(i, 8).FormulaR1C1 = "=TODAY() + (RC[-1]/12*365)"
wksBasis.Cells(i, 9).FormulaR1C1 = "=IF(RC[-3]=""00.00.0000"",""Prüfung durch Technik"",IF(RC[-1]>RC[-3],""J"",""N""))"
Cells(i, 9).Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""J"""
    Selection.FormatConditions(1).Font.ColorIndex = 3
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
        Formula1:="=""J"""
    Selection.FormatConditions(2).Font.ColorIndex = xlAutomatic
    
wksBasis.Cells(i, 10) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("Gesamtbestand ohne Sonderläger"). _
Range("A1:Q35000"), 16, False) 'Menge
wksBasis.Cells(i, 11) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("gesamtbestand"). _
Range("A1:M35000"), 13, False) 'Preis lt. Steuerung
wksBasis.Cells(i, 12) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("Gesamtbestand ohne Sonderläger"). _
Range("A1:Q35000"), 17, False) 'Wert Lagerbestand
wksBasis.Cells(i, 13) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 13, False) 'Verbrauch 2002
wksBasis.Cells(i, 14) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 14, False) 'Verbrauch 2003
wksBasis.Cells(i, 15) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 15, False) 'Verbrauch 2004
wksBasis.Cells(i, 16) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 8, False) 'VStati Inland
wksBasis.Cells(i, 17) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 9, False) 'VStati Export
wksBasis.Cells(i, 18) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 10, False) 'VStati TG
wksBasis.Cells(i, 21).FormulaR1C1 = "=RC[-1]/100*RC[-10]"
wksBasis.Cells(i, 23) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("2120"). _
Range("A1:Q35000"), 12, False) 'Bestand 2120
wksBasis.Cells(i, 24) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("2140"). _
Range("A1:Q35000"), 12, False) 'Bestand 2140
wksBasis.Cells(i, 25) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("2145"). _
Range("A1:Q35000"), 12, False) 'Bestand 2145
wksBasis.Cells(i, 26) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("2185"). _
Range("A1:Q35000"), 12, False) 'Bestand 2185
wksBasis.Cells(i, 27) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("5000"). _
Range("A1:Q35000"), 12, False) 'Bestand 5000
End If
Next i
wkbQuelle4.Close False
wkbQuelle6.Close False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Bild


Betrifft: AW: Wert in Bereich finden von: Claus Bauer
Geschrieben am: 17.02.2005 22:51:10

Hallo Melanie,

kann es sein, dass du dich da etwas verrant hast?
Da ich kein VBA kann, aber im Excel an sich recht gut bin, würde ich hier in Spalte D mit Formeln WENN(ISTFEHLER(VERGLEICH( ... etc. arbeiten, und in der Spalte AD natürlich den guten alten SVERWEIS. Der Makro müsste das doch problemlos in die betreffende letzte Zeile einfügen können, evtl. noch einfrieren (Copy und Werte einfügen) - fertig

Jetzt gibt´s 2 Möglichkeiten:
1.) Es fiel dir wie Tomaten von den Augen - würde mich freuen, dann darfst du ggf. wegen der Formeln nochmal nachfragen
2.) Ich habe deine Frage völlig falsch interpretiert, und meine Ausführungen waren total unsachlich und haben dir nichts gebracht.

Falls 2.) der Fall ist, entschuldige ich mich hiermit - bin heute zum ersten mal in so ´nem Forum und wollte halt auch mal helfen

Trotzdem liebe Grüße
Claus


Bild


Betrifft: AW: Wert in Bereich finden von: Melanie
Geschrieben am: 18.02.2005 08:59:10

Hallo Claus und alle anderen!

Tja, ich weiß nicht, ob mir eine Formel helfen würde. Wie sähe die Formel mit dem ISTFEHLER denn genau aus?
Die Schwierigkeit an meiner Datei ist nämlich die, dass sich die Felder "per Knopfdruck" selber ausfüllen müssen. Meine Kollegen sind nicht so die Excel-Spezies und wenn ich denen sage, dass sie noch irgendwelche Formeln runterkopieren müssen, dann ist das für die echt eine anspruchsvolle Aufgabe - also muss ich das in meinen Code einarbeiten. Aber WIE mache ich das per Formel, dass sich der zu durchsuchende Bereich nach unten immer erweitert??? Und wie bekomme ich das hin, dass ich in Spalte AD nicht das #NV ausgewiesen bekomme, falls der Wert in Spalte A weiter oben schon mal ist??

Allerdings wäre ich für den "direkten" Weg per Code glücklicher. Weiss sonst noch jemand Rat?

Viele Grüße,
Melanie


Bild


Betrifft: AW: Wert in Bereich finden von: Claus Bauer
Geschrieben am: 18.02.2005 12:29:40

Hallo Melanie,

sodele, ich habe dir die Formeln als VBA-Code zusammengestellt (über Makro aufzeichnen erstellt, nachdem ich mir die Formeln gebastelt hatte)

Habe einige Kommentare dazugeschrieben, damit du die Chance hast, beim schrittweisen ablaufenlassen den Sinn oder Unsinn der Aktionen zu erkennen.

Du musst diesen Teil in deinen vorhandenen Ablauf einbauen, wo genau bekommst du bestimmt hin:

' hier in Spalte S springen (die Zeile, die hier als Beispiel zum testen 22 war, ergibt sich ja aus dem vorherigen Programmablauf)
Range("S22").Select
'Formel: gibt "doppelt" zurück, wenn Art.Nr. vorher schon vorkommt, ansonsten leer
' Knackpunkt: der durchsuchte Bereich beginnt bei A2 und geht bis A(n-1)
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(MATCH(RC[-18],R2C[-18]:R[-1]C[-18],0)),"""",""doppelt"")"
'Einfrieren: Copy und Werte einfügen
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' hier in Spalte AD springen (die Zeile, die hier als Beispiel zum testen 22 war, ergibt sich ja aus dem vorherigen Programmablauf)
Range("AD22").Select
'Formel: SVERWEIS gibt den Begriff bei "Ausdruck erstellen" vom ersten gefundenen zurück, wenn Art.Nr. vorher schon vorkommt, ansonsten leer
' Knackpunkt: die durchsuchte Matrix beginnt bei A2 und geht bis AD(n-1)
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(MATCH(RC[-29],R2C[-29]:R[-1]C[-29],0)),"""",VLOOKUP(RC[-29],R2C[-29]:R[-1]C,30,0))"
'Einfrieren: Copy und Werte einfügen
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Hoffentlich klappt´s, sonst frage bitte nochmal nach.
Ein feedback, falls es klappt, wäre sehr nett, das ist mein erster Versuch, über diesem Weg jemandem zu helfen. (deshalb bitte auch gründlich testen ;-) )

Grüßle aus dem Schwabenländle
Claus


Bild


Betrifft: AW: Wert in Bereich finden von: Melanie
Geschrieben am: 18.02.2005 13:54:18

Hallo Claus!

Jaaaaaa - es klappt!!!
(Ich weiß zwar nicht wieso, aber es klappt!!! Ich bin eben kein "Funktionsspezialist", mache über die Makros viele Sachen mit einfachen, aber umständlichen, Wenn-Dann-Abfragen)
Hast Du noch eine verständliche Erklärung für mich, wie Du Deine Formel mit dem ISTFEHLER und dem VERGELEICH aufgebaut hast? Welches Ergebnis liefert die Vergleichsfunktion und welches der ISTFEHLER??
Danke Dir auf jeden Fall!!!
Gruß,
Melanie


Bild


Betrifft: AW: Wert in Bereich finden von: Claus Bauer
Geschrieben am: 18.02.2005 20:56:53

Hallo Melanie,

also das freut mich ja riesig, wenn ich dir hier weiterhelfen konnte.

Der Tabelle nach zu urteilen, machst du einen ähnlichen Job wie ich hier, ich bin hier sozusagen der Datenklopfer betreffs Stammdaten und Stücklisten und habe durchaus auch öfter mal mit Listen bezüglich Verschrottungen zu tun. So nebenbei werde ich auch über alle möglichen Excel-Probleme befragt, ich glaub da bin ich ganz fit in der Zwischenzeit.

Nun zu den Funktionen: (im makro-Code verstehe ich diese auch nur begrenzt - ich erzeuge sie mir dort immer dadurch, dass ich "von Hand" erstellte Formeln aufzeichne), deshalb hier die Formel in Deutsch:

=WENN(ISTFEHLER(VERGLEICH(A22;A$2:A21;0));"";"doppelt")

von Innen nach Außen: VERGLEICH(A22;A$2:A21;0)
sucht den Wert aus A22 im Bereich A$2:A21
die Null sagt: Suche genaue Übereinstimmung, also nicht den nächstkleieneren oder nächstgrößeren Wert
Knackpunkt: Das Dollarzeichen. Ohne das, würde beim kopieren der Formel in höheren Spalten nicht von der zweiten Zeile bis n-1 gesucht werden.
Das Ergebnis dieser Formel ist: Wenn der Wert aus A22 gefunden wird: Eine Zahl, wenn der Wert nicht dabei ist aber die Fehlermeldung #NV

Also, genau wenn das der Fall ist, also #NV, dann ist es ja nicht doppelt, Istfehler liefert Wahr und die Wenn-Formel macht "", also eine leere Zelle. Ansonsten halt den Text "doppelt". Übrigens sollte der Text, wenn man´s gaaanz genau nimmt, nicht "doppelt" sondern "mehrfach" oder "Artikelnummer kommt weiter oben auch vor", oder so ähnlich, denn es kann ja mehr als eine Wiederholung geben.

VERGLEICH ist quasi SVERWEIS aber ohne den Verweis. SVERWEIS ginge also im Prinzip genauso, denn die benötigte Fehlermeldung würde auch SVERWEIS liefern.

Sodele, jetzt geh ich aber mal bald nach Hause
Ganz liebe Grüße
Claus


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Wert in Bereich finden "