Clever-Excel-Forum

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

Moin

Ohne Sub.

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

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

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

Foregner

shift-del

Foregner

Gast 123

Foregner