"Do While" Schleife

[Mitness]

Hallo liebe Community,

ich habe folgende Frage an euch: Wie kann ich bei der If-Anweisung und der Do While Schleife, mehrere Werte angeben?

Dim x As String
x = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
If Range("B35").Value <> "Birne" Then
With Range("B35:B" & x)
  .Columns(2).FormulaLocal = "=Zufallszahl()"
    With ActiveWorkbook.Worksheets("Matching").Sort
        .SetRange Range("B35:C" & x)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    .Columns(2).ClearContents
End With
End If

Do While Range("B35").Value = "Birne"
With Range("B35:B" & x)
  .Columns(2).FormulaLocal = "=Zufallszahl()"
    With ActiveWorkbook.Worksheets("Matching").Sort
        .SetRange Range("B35:C" & x)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    .Columns(2).ClearContents
End With
Loop


An sich funktioniert es nach meinen Wünschen, nur möchte ich jetzt z. B. auf mehrere Werte als "Birne" vergleichen, quasi "Birne, Apfel, Kirsche" usw.. Auch bei der Range würde ich gerne mehrere Bereiche angeben können z. B. "Do While Range("B35, B36, B37").Value = "Birne, Apfel, Kirsche" ".
Könntet Ihr mir freundlicherweise weiterhelfen, in dem Ihr mir sagt, wie ich das richtig zu deklarieren habe? 

Liebe Grüße
Mitness   

[Steffl]

Hallo,

vielleicht so?

Code:

Sub prcMitness()

   Dim vntArray As Variant
   Dim rngZelle As Range
   Dim lngC As Long
  
   vntArray = Array("Birne", "Apfel", "Kirsche")
  
   For Each rngZelle In Range("B35:B37").Cells
      For lngC = 0 To UBound(vntArray)
         If rngZelle.Value = vntArray(lngC) Then
            With Range("B35:B" & x)
              .Columns(2).FormulaLocal = "=Zufallszahl()"
                With ActiveWorkbook.Worksheets("Matching").Sort
                    .SetRange Range("B35:C" & x)
                    .Header = xlNo
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
                .Columns(2).ClearContents
            End With
         End If
      Next lngC
   Next rngZelle
End Sub

[Mitness]

Vielen Dank! Hat funktioniert für mich.