Hallo, ich begrüße Euch,

ich brauche freundlicher Weise eine Hilfe, denn ich möchte gerne wenn möglich in diesem Code eine Änderung für die Ausgaben einiger Arrays.

Die jetzigen Ausgaben der Arrays von X16:X21 mit den Zahlen von 0-9  die nach edem Klick nur die Reihenfolge ändern sollten nicht verwendet werden, sie werden nur für die Suche in den Arrays X16:X21 für die Zahlen 3 oder 4 gebraucht um für die nebenstehenden Arrays in der selben Zeile für die Ausgabe nach Spalt R1 zufinden

Es sollten also weiterhin auch nach jedem Klick wiederum nur die Arrays die den Zelleninhalt 3 oder 4 nebeneinander nach R1 ausgegeben werden.                                                                                                                                     
Wenn zB. in einem Array die Zahl 3 oder 4 vorkommt, dann sollte das daneben stehende Array also von X16 wäre das Array = (Y16,Z16,AA16,AB16,AC16 ) mit den Zahlen  1 1 1 1 1 ausgegeben werden usw. es sind dann bei jedem Klick dann auch mehrere möglch oder auch keine.

Der Zäler in der Spalte R7 sollte nicht die Klicks sondern die ausgegebenen Spalten zählen.

Ich hoffe das man meine Erklärung verständlich ist, Danke im Voraus

Mit freundlichem Gruß

Horst     

Option Explicit

Sub Makro1()

'Range("R7") = 0

 End Sub
 
Sub Makro2()
Dim R
Dim NeueSpalte As Long
Dim AppCalc

    AppCalc = Application.Calculation 'speichern
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    With ActiveSheet
       For Each R In Array("X16:X21",)
           NeueSpalte = Application.Max(18, .Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1).Column) 'Mindestspalte "R" ist 18te Spalte
           With Range(R)
              .Cells(1, NeueSpalte).Resize(6, 1) = IIf(.Rows.Count = 1, Application.Transpose(.Value), .Value)
 
     'Arrays für Zahlensuche 3 oder 4             Arrays für die Ausgaben senkrecht neneinander in Spalte R1
     
     ' X16                                        Y16, Z16, AA16, AB16, AC16, AD16
     ' X17                                        Y17, Z17, AA17, AB17, AC17, AD17
     ' X18                                        Y18, Z18, AA18, AB18, AC18, AD18
     ' X19                                        Y19, Z19, AA19, AB19, AC19, AD19
     ' X20                                        Y20, Z20, AA20, AB20, AC20, AD20
     ' X21                                        Y21, Z21, AA21, AB21, AC21, AD21
             
           End With
      Next
       .Range("R7").Value = .Range("R7").Value + 1
   End With
  Application.EnableEvents = True
  Application.Calculation = AppCalc 'zurückspielen
       
End Sub

Sub Makro3()

   Dim c As Range
    
   Set c = Range("R1").CurrentRegion
   Set c = c.Resize(6)
   c.ClearContents
   
 Range("R7") = 0
 

End Sub