Spalte b kopieren wenn Spalte A = J

Hallo Liebe Forumsmitglieder,
ich habe eine Tabelle PQ Allgemein. In der Spalte A ist die Überschrift "Auswahl aaa" die darunter liegenden Zeilen sind mit "n, j, oder u" gefüllt. Die Anzahl der Zeilen variiert, es können mal 30 aber auch mal 700 sein.
Es sollen alle Werte aus Spalte B kopiert werden, die in Spalte A in "j" haben. Diese Werte sollen untereinander in Spalte AB eingefügt werden.
Ist in Spalte A ein "n" dann sollen die Werte aus Spalte B in AC kopiert und eingefügt werden und bei "u" in Spalte AD. Immer ab Zeile 2.
Beispiel
Spalten.................Spalten
Kopieren...............Einfügen
... A ......B............. AB.(j)... AC.(n). AD (u)
1 .j ..... 30..... ......30....... 40.......25
2 .n..... 40........... 40.....................1
3 .u...... 25 ...........4711
4 . j...... 40
5 .j.....4711
6 .u.....1
7 usw.
Ich möchte dies gerne per VBA machen, da ich die Zahlen anschließend weiterverarbeiten muss. Ich hoffe ihr könnt mir helfen.
Tanja

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Unit() Dim C As Range, j As Long, n As Long, u As Long For Each C In Cells(1).CurrentRegion.Columns(1).Cells Select Case C Case "j": j = j + 1: Range("AB" & j) = C.Offset(0, 1) Case "n": n = n + 1: Range("AC" & n) = C.Offset(0, 1) Case "u": u = u + 1: Range("AD" & u) = C.Offset(0, 1) End Select Next End Sub

Option Explicit Sub test() Dim arA_B, arAB, arAC, arAD Dim i&, cntAB&, cntAC&, cntAD& arA_B = Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row) ReDim arAB(1 To 1, 1 To UBound(arA_B)) arAC = arAB arAD = arAB For i = LBound(arA_B) To UBound(arA_B) Select Case arA_B(i, 1) Case "j": cntAB = cntAB + 1: arAB(1, cntAB) = arA_B(i, 2) Case "n": cntAC = cntAC + 1: arAC(1, cntAC) = arA_B(i, 2) Case "u": cntAD = cntAD + 1: arAD(1, cntAD) = arA_B(i, 2) End Select Next ReDim Preserve arAB(1 To 1, 1 To cntAB) ReDim Preserve arAC(1 To 1, 1 To cntAC) ReDim Preserve arAD(1 To 1, 1 To cntAD) Range("AB2").Resize(cntAB) = Application.Transpose(arAB) Range("AC2").Resize(cntAC) = Application.Transpose(arAC) Range("AD2").Resize(cntAD) = Application.Transpose(arAD) End Sub

Hallo Liebes Forum,
ich habe obigen Code von Ralf bekommen, der funktioniert auch super. Leider musste ich meine Datei bedingt durch Power Query umbauen und ich schaffe es leider nicht, den Code entsprechend anzupassen. Vielleicht kann mir jemand dabei helfen?
Folgendes Problem:
In den Spalten A bis I habe ich untereinander, in variablen Längen (mal 30 Zeilen mal 300) und Anordnungen die Buchstaben j, n, u oder andere Zeichen stehen. Relevant sind nur j, n, u. In Spalte J habe ich die dazugehörigen Werte. Jetzt soll in die Spalte L ab Zeile 2 alle Werte der Spalte J untereinander geschrieben werden, die ein j in Spalte a haben. In Spalte M, alle Werte die in Spalte a ein n haben und Spalte n soll mit den Werten von U gefüllt werden
Spalte A Spalte B Spalte C ................ Spalte J ........Spalte M Spalte N
j...................n.............n............................4711................4711.........4712
n...................j.............u............................ 4712
Zum besseren Verständnis versuche ich eine Musterdatei beizufügen. Wäre super wenn ihr mir nochmal helfen könnt.
Lieben Dank
Tanja

Sub Kopierenaaa() 'Sub test() 'herber Dim arA_J, arl, arm, arn Dim i&, cntl&, cntm&, cntN&, colnr& arA_J = Range("A2:J" & Cells(Rows.Count, 1).End(xlUp).Row) Worksheets("Tabelle2").Select ReDim arl(1 To 1, 1 To UBound(arA_J)) arm = arl arn = arl colnr = UBound(arA_J, 2) 'wert aus spalte "J" For i = LBound(arA_J) To UBound(arA_J) Select Case arA_J(i, 1) Case "j": cntl = cntl + 1: arl(1, cntl) = arA_J(i, colnr) Case "n": cntm = cntm + 1: arm(1, cntm) = arA_J(i, colnr) Case "u": cntN = cntN + 1: arn(1, cntN) = arA_J(i, colnr) End Select Next ReDim Preserve arl(1 To 1, 1 To cntl) ReDim Preserve arm(1 To 1, 1 To cntm) ReDim Preserve arn(1 To 1, 1 To cntN) Range("L2").Resize(cntl) = Application.Transpose(arl) Range("M2").Resize(cntm) = Application.Transpose(arm) Range("N2").Resize(cntN) = Application.Transpose(arn) End Sub

Beliebteste Forumthreads (12 Monate)

Spalte b kopieren wenn Spalte A = J

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread