VBA suchen und schreiben automatisiert

[tw3aker]

Hey,
 
Danke. Jetzt nur folgende Frage: Habe das Ganze als Makro hinzugefügt. Einige meiner Rezepte eingegeben, das ein oder andere Rezept eingegeben welches er nicht finden soll, er gibt mir dennoch nichts aus. Woran liegt das?
 
Danke und Gruß

[snb]

Bedeutet das 'Betreff' dieser Thread (VBA suchen und schreiben automatisiert)


Das die Helfer hier alles suchen und schreiben sollten und du nichts ?

[tw3aker]

Leider kann ich kein VBA, aus dem Grund frage ich Menschen, die das können und auch helfen wollen. Handel in meinen Bereichen von denen ich etwas verstehe nicht anders.
Gruß

[Gast 123]

Hallo,

das ein oder andere Rezept eingegeben welches er nicht finden soll, er gibt mir dennoch nichts aus.

Sorry, ich denke das ich mir viele Dinge schon richtig vorstellen kann, aber hier stehe ich - "völlig auf dem Schlauch!!"

Nach etwas suchen, was man nicht finden soll???  Sorry, das kann ich mir irgendwie nicht logisch vorstellen!
Am besten waere ein Beispieldatei mit Fantasienamen, bei Datenschutz ginge das auch über meine EMail.
Mir fehlt hier im Augenblick jeder -logische Zusammenhang- wie das Ergebnis dann aussehen soll?? 

mfg  Gast 123

[tw3aker]

Hallo Gast 123,

habe dir mal unsere Übungsmappe vorbereitet, wie ich mir das vorstelle.

Lieben Gruß und 1000 Dank!

[Gast 123]

Hallo,

danke für die Beispieldatei, mir fiel es wie Schuppen von den Augen was du meintest.  Ist ja auch völlig korrekt.
In der Technik gibt es einen Fachbegriff dafür:  Inverse oder Invertierte Logik, bevorzugt bei Bollscher Algebra
Bekannt bei komplexen Maschinensteuerungen:  Q=A+B   Q=Schalter A gedrückt + Schalter B nicht gedrückt

Wenn man es verstanden hat ist das Makro leicht umzuschreiben.  Ich denke jetzt klappt es wie gewünscht. Zwei Kleinigkeiten noch, die ihr selbst aendern könnt.  Wenn kein Rezept gefunden wurde wird eine Meldung ausgegeben: "No Find"  Wenn ihr diese Meldung nicht haben wollt bitte diese Zeile löschen:  If rFind Is Nothing Then AC.Cells(1, 0) = "No Find"

Der Sprungbefehl dahinter muss aber unbedingt bestehen bleiben!!  Ich fange wegen dieser Meldung auch mit Zelle "J2" und "L2" an. Wenn ihr den Befehl rausnehmt könnt ihr den Range.Bereich manuell auf "J1" und L1" setzen.  Man kann es auch so lassen, wenn man ja weiss wo das Makro anfaengt.

mfg  Gast 123 

Code:

Option Explicit      '21.2.2017  Gast 123  Clever Forum
'neu aufgenommen:  Rezeptsuche Neu
Const ASW = "Auswertung"   'Auswertung

'A=gefüllt, D=Ltr, H=Artikel, J=datumgang
Dim rFind As Object, AJ As Object


'Extra Blatt - Produkt5 auflisten
'Invers suche nach Rezepten + Artikel   (No Artikel-Nr !!)

Sub Produkt5_Invers_auflisten()
Dim x As Integer, z As Integer, flg
Dim Adr1 As String, nAdr As String
Dim ATB As Worksheet, AC As Object
Set ATB = Worksheets(ASW)
z = 2   '1. Zeile in Produkt5

With Worksheets("Produkt 5")
  'alte Liste ganz löschen
  .Range("I2:I100") = Empty
  .Range("K2:K100") = Empty
  .Range("A2:F1000") = Empty
 
  'Schleife: Rezeptspalte durchsuchen
  For Each AC In .Range("J2:J100")
     If AC.Value = Empty Then Exit For
     'in Spalte H1 Artikel suchen
     Set rFind = ATB.Columns("F").Find(What:=AC, After:=Range("F1"), _
         LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
     
     'Meldung wenn kein Rezept gefunden wurde
     If rFind Is Nothing Then AC.Cells(1, 0) = "No Find"
     If rFind Is Nothing Then GoTo nxt  

     Adr1 = rFind.Address
     x = rFind.Row:  nAdr = Adr1
     
     Do 'Do Schleife für alle Jahrgaenge
        flg = Empty  'Auswertungs Flag
        'Schleife für Artikel Nr. suchen
        For Each AJ In .Range("L2:L100")
          If AJ.Value = Empty Then Exit For
          If ATB.Cells(x, "H") = AJ.Value Then flg = "Find": Exit For
        Next AJ
        '** nur auflisten wenn in Artikel Liste -nicht vorhanden-!!
        If flg = Empty Then
           .Cells(z, 1) = CDate(ATB.Cells(x, 1))  'Datum
           .Cells(z, 2) = ATB.Cells(x, 4).Value   'Fl.Grösse
           .Cells(z, 3) = ATB.Cells(x, 6).Value   'Rezept
           .Cells(z, 4) = ATB.Cells(x, 7).Value   'Flaschen
           .Cells(z, 5) = ATB.Cells(x, 8).Value   'Artikel
           .Cells(z, 6) = ATB.Cells(x, 10).Value  'Jahrgang
            z = z + 1
        End If
       'next Jahrgang Zeile suchen bis Ende
       Set rFind = ATB.Columns("F").FindNext(After:=Range(nAdr))
       nAdr = rFind.Address: x = rFind.Row
     Loop Until rFind.Address = Adr1

nxt:  'überspringen
  Next AC
End With
End Sub

.

[tw3aker]

Hallo Gast 123,
jetzt ist es perfekt!!! Jetzt hilft es enorm!! Vielen, vielen Dank!!
LG by tw3aker