315 Aufrufe
Gefragt in Tabellenkalkulation von

Hallo und einen schönen 1. Advent!
Uii, hier hat sich ja etwas an dem Layout der Seite getan, richtig schick yes

Ich arbeite noch mit Excel 2002 und habe ein Zufallsgenerator Makro.
Nun möchte ich diesen etwas erweitern, in dem noch zwei Kriterien einfliessen.
Wer ist so freundlich und hilft mir?

Bisher sieht die VBA so aus:

Sub Zufall()

Dim Wert
Dim LetzteZeile As Long     'letzte Zeile
Dim LetzteSpalte As Long    'letzte Spalte

'letzte Zeile auffinden:
   LetzteZeile = ActiveSheet.Cells(65536, 1).End(xlUp).Row 'Zahl nach dem Komma = Spalte
 

 Randomize 
 Wert = Int((Rnd * LetzteZeile) + 1)
 With Tabelle1   'CodeName! der Tabelle
  
  .Range("BG2") = .Cells(Wert, 49).Value
  .Range("BF2") = Wert
  
End With
End Sub

Nun würde ich gerne die Zahlen nur ausgegeben haben wenn in der Spalte "AZ" ein "ja" und in der Spalte "BD" ein "X" steht.

Ist das möglich?

Mit freundlichen Grüßen
Mick

8 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Mick,

ich gehe mal davon aus, dass die Zellen AZ2 = "ja" und BD2 = "x" sind:

Sub Zufall()

Dim Wert
Dim LetzteZeile As Long     'letzte Zeile
Dim LetzteSpalte As Long    'letzte Spalte

'letzte Zeile auffinden:
LetzteZeile = ActiveSheet.Cells(65536, 1).End(xlUp).Row 'Zahl nach dem Komma = Spalte

With Tabelle1   'CodeName! der Tabelle
  If .Range("AZ2") = "ja" And .Range("BD2") = "x" Then
     Randomize
     Wert = Int((Rnd * LetzteZeile) + 1)
     .Range("BG2") = .Cells(Wert, 49).Value
     .Range("BF2") = Wert
  End If
End With
End Sub

Gruß

M.O.

0 Punkte
Beantwortet von
Hallo M.O.,

gestern kam ich nicht dazu Dir zu antworten.
Herzlichen Dank für Deine Hilfe! Kam heute erst dazu den Code zu testen.
Irgenwie funktioniert er nicht?
Hätte ich evtl. erwähnen müssen, daß in Spalte AW eine fortlaufende Nummer generiert wird sobald in einer Zelle der Zeile etwas eingegeben wir und in Spalte AZ ein "ja" wenn das passende Bild in einem Ordner vorhanden ist.
Oder ist das nicht ausschlaggebend?

Also in BG2 wird dann per Zufall eine fortlaufende Nummer der Spalte AW angezeigt und in BF2 die dazugehörige Zeilennummer.

Mit freundlichen Grüßen
Mick
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Mick,

ja, das hättest du erwähnen müssen wink.

Wenn das Makro nur ausgeführt werden soll, wenn in der betreffenden Zeile die Spalten AZ und BG geprüft werden sollen, dann kannst du das nicht in dein gepostetes Makro einbauen, da du hier keinerlei Bezug zu der Zelle hast, in der die Eingabe erfolgt. Ich nehme mal an, das Makro wird duch ein Worksheet-Change-Ereignis ausgelöst. Hier müsstet du die entsprechende Abfrage einbauen: Dabei kommt es auch noch darauf an, ob das "ja" in Spalte AZ und das "x" in Spalte BD per Hand eingetragen werden, Falls das so ist, kannst du die Überprüfung, ob das Makro Zufall aufgerufen wird, so machen:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("AZ:AZ,BD:BD")) Is Nothing Then
         
        If Cells(Target.Row, 52) = "ja" And Cells(Target.Row, 56) = "x" Then
            Call Zufall
        End If
      
    End If

End Sub


Gruß

M.O.

0 Punkte
Beantwortet von

Guten Abend M.O. und alle anderen,

tut mir leid!! Ich dachte das wäre nicht von Belang. Aber als ich den Code probiert hatte, dachte ich evtl. hängt das doch damit zusammen.
Das "x" wird per Hand eingefügt.

Du hast recht es wird über ein Worksheet-Change-Ereignis ausgelöst

Private Sub Worksheet_Change(ByVal Target As Range)
'Prüfen, ob Eingabe in Spalte A erfolgt ist
If Not Intersect(Target, Range("A:A")) Is Nothing Then
  If Target.Row > 2 Then               'nur wenn ab Zeile 3 etwas eingegeben wurde
  If IsEmpty(Cells(Target.Row, 1)) = False And IsEmpty(Cells(Target.Row, 48)) = True Then  'Prüfen, ob Eingabe in Spalte A erfolgt ist und Spalte AV leer ist
      With Cells(Target.Row, 48)
     .Value = Date                       'dann in Spalte AV das Datum einfügen
     .NumberFormat = "YYYY.MM.DD"        'und formatieren
     End With
   End If
 End If
End If

'nun für Spalte B
If Not Intersect(Target, Range("B:B")) Is Nothing Then
  If Target.Row > 2 Then
  'prüfen, ob eine Eingabe in Spalte B erfolgt ist und ob in Spalte AW die betreffende Zelle leer ist und falls ja, dann neue Nummer einfügen,
  If IsEmpty(Cells(Target.Row, 2)) = False And IsEmpty(Cells(Target.Row, 49)) = True Then Cells(Target.Row, 49) = Application.WorksheetFunction.Max(Range("AW:AW")) + 1
 End If
End If


End Sub

Muß ich dann nur den Part "And Cells(Target.Row, 56) = "x"" rauslöschen und den Rest dazu einfügen?

Mit freundlichen Grüßen
Mick

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Mick,

ich sehe hier aber nicht, dass das Makro Zufall hier aufgerufen wird.

Falls nur die Zelle AZ per Hand ausgefüllt wird, dann ergänze deinen vorhandenen Code (nach den letzten End If) wie folgt:

If Not Intersect(Target, Range("AZ:AZ")) Is Nothing Then
         
  If Target.Value = "x" Then all Zufall
 
End If

Gruß

M.O.

0 Punkte
Beantwortet von
Bearbeitet

Hallo M.O.,

mir ist das jetzt ein wenig peinlich! blush
Du opferst Deine Zeit und bist so geduldig um mir zu helfen und ich habe es Dir falsch erklärt. Tut mir wirklich sehr leid crying

Ich habe meinen Fehler entdeckt und versuche es nun richtig zu erklären.

In Tabellenblatt 1 (=Ansichtskarten) habe ich einen Button Zufall den ich per Hand auslöse (siehe 1. Post)

In Spalte AZ wird mit einem Makro ein "ja" oder "nein" generiert, wenn in einem angelegten Ordner
das passende Bild vorhanden ist.

Sub Bilder_vorhanden_Vorderseite()

Dim strPfad As String
Dim strDatei As String
Dim lngLetzte As Long
Dim lngZeile As Long

'Pfad in dem die Bilder liegen - anpassen
strPfad = "G:\BILDER\Ansichtskarten\0_Bilder fuer Liste_kurze Seite 3cm_in jpg\"

With ActiveSheet

  'letzte beschriebene Zeile in Spalte AL ermitteln
   lngLetzte = .Cells(Rows.Count, 38).End(xlUp).Row
       
   For lngZeile = 3 To lngLetzte
     strDatei = strPfad & .Cells(lngZeile, 38).Value & ".jpg"    'Pfad und Bildname generieren
      'prüfen, ob Bild vorhanden ist
     
     If Len(Dir(strDatei)) = 0 Then
        .Cells(lngZeile, 52) = "nein"
     Else
        .Cells(lngZeile, 52) = "ja"
     End If
   
  Next lngZeile

End With

End Sub

In Spalte BD gebe ich das "x" per Hand ein.

In Spalte AW wird eine fortlaufende Nummerierung per Worksheet-Change-Ereignis generiert, wenn in der selben Zeile in Spalte B etwas eingegeben wird. Diese soll dann mit dem Zufall-Genarator ausgegeben werden mit der dazugehörigen Zeilennummer.

Also wird in diesen Spalten auf die es ankommt nichts mit einem Worksheet-Change-Ereignis ausgelöst.

Einen schönen Abend wünscht
Mick

PS Ergänzung:
Dein erstes Makro funktioniert wenn in Zeile 2 die Kriterien erfüllt sind.
Ich habe bisher 712 Zeilen (ausgenommen Zeile 1 & 2 da stehen die Überschriften) und es kommen immer mehr dazu.
Habe versucht den Part "If .Range("AZ2") = "ja" And .Range("BD2") = "x" Then" durch AZ:AZ und BD:BD
zu ersetzen, das funktioniert aber nicht?

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
 
Beste Antwort

Hallo Mick,

wie du ja festgestellt hast, funktioniert das nicht. Aber das folgende Makro sollte funktionieren:

Sub Zufall()

Dim Wert
Dim LetzteZeile As Long     'letzte Zeile
Dim LetzteSpalte As Long    'letzte Spalte
Dim bAusgabe As Boolean     'Schalter für Ausgabe der Zufallszahl

'letzte Zeile auffinden:
LetzteZeile = ActiveSheet.Cells(65536, 1).End(xlUp).Row 'Zahl nach dem Komma = Spalte
     
With Tabelle1   'CodeName! der Tabelle
   'Schleife wird solange durchlaufen, bis eine Zeilennummer generiert wird, bei der die
   'Voraussetzungen für die Ausgabe erfüllt sind
   Do
      Randomize
      Wert = Int((Rnd * LetzteZeile) + 1)
      'Prüfung ob in Spalte AZ ja und in Spalte BD x steht, falls ja, wird Schalter für Ausgabe auf Wahr gesetzt
      If .Cells(Wert, 52) = "ja" And .Cells(Wert, 56) = "x" Then bAusgabe = True
   Loop Until bAusgabe = True
   
   .Range("BG2") = .Cells(Wert, 49).Value
   .Range("BF2") = Wert
      
End With
End Sub

Gruß

M.O.

0 Punkte
Beantwortet von

Guten Abend M.O.

herzlichen Dank für Deine Geduld und Deine Mühe yes
Du hast mir sehr geholfen, jetzt funktioniert alles nach meinen Wünschen. Danke!!

Ich wünsche Dir und allen hier im Forum schöne Feiertage
Mick

...