Array mehrfach Ausgeben !

[Foregner]

Hallo !
Ich bin mal wieder an meine Grenzen gestossen, und hoffe das ihr mir Helfen könnt.
In der letzten Spalte meiner Tabelle, Schreibe ich vier unterschiedliche Kürzel
hinter den Datensätzen.
Die mit einer Suchfunktion in ein Array geladen werden, um an anderer stelle
Den Inhalt auszugeben.
Ich habs soweit hinbekommen das es bei einem Suchbegriff Funktioniert.
OK, mann könnte diesen Code vier mal Kopieren, und mit vier Makros mit den
unterschiedlichen Suchbegriffen Starten.
Meine Frage währe, ob man sowas in einem Sub lösen kann ?
Eine Bspl. Datei werde ich Anhängen

LG Gerhard

[shift-del]

Moin

Ohne Sub.

[Foregner]

Hallo shift-del
Erstmal Danke, für den Link, aber ich habe mit Power Querry oder auch mit
Pivot Tabellen noch nie gearbeitet.
Da ich mich nur mit VBA und Formeln beschäftige, und sehr an einer Wissens-
erweiterung in diesem Bereich Anstrebe.
würde ich eine Lösung/Lösungsansatz mit VBA vorziehen.

LG Gerhard

[Gast 123]

Hallo Gerhard

dein Anliegen ist leichter zu lesen und zu verstehen wenn du den Text in einer Zeile ohne Zeilenumbrüche schreibst.

Hier mal ein Simpel Code von einem Amateur OHNE Array!  Bei vielen Daten hat ein Array klar grosse Vorteile in Bezug auf die Arbeitsgeschwindigkeit.  Bei so wenig Daten geht das auch in einer einzigen For Next Schleife ohne ScreenUpdating = False. Bei vielen Zeilen bitte noch im Code mit einfügen.  Sollte "k" mal Grossgeschrieben sein wird es trotzdem korrekt ausgewertet.

mfg  Gast 123

Code:

Sub Suchbegriff_auflisten()
Dim k, u, t, v As Integer
Dim AC As Range, lz1 As Long
  'Zaehler auf 1. Zeile in Spalte G-J setzen
  k = 5: u = 5: t = 5: v = 5
  'LastZell in Spalte B Nachname suchen
  lz1 = Cells(Rows.Count, 2).End(xlUp).Row
  'alte Ergbnissliste löschen G5:Jxx
  Range("G5:J" & lz1).ClearContents
  'Schleife in Spalte D für alle Kürzel finden
  For Each AC In Range("D4:D" & lz1)
      If LCase(AC) = "k" Then
         Cells(k, 7) = AC.Offset(0, -2)
         k = k + 1
      ElseIf AC.Value = "U" Then
         Cells(u, 8) = AC.Offset(0, -2)
         u = u + 1
      ElseIf AC.Value = "TZ" Then
         Cells(t, 9) = AC.Offset(0, -2)
         t = t + 1
      ElseIf AC.Value = "V" Then
         Cells(v, 10) = AC.Offset(0, -2)
         v = v + 1
      End If
  Next AC
End Sub

[Foregner]

Hallo Gast 123

Herzlichen Dank, für deine Hilfe. Funktioniert genau so wie es soll. Da hab ich aber viel zu kompliziert Gedacht. und Sorry wegen der Zeilenumbrüche, werde es beherzigen.
lg Gerhard