Spalteninhalt ändern und neu ausgeben!

Hallo zusammen,
ich hab da ein Problem, wo ich echt super dankbar wäre wenn ihr mir da helfen würdet. Da ich in VBA so gar keine Ahnung habe, ich mir aber schon so ein bisschen denke, dass das nicht anders zu lösen ist wende ich mich ans Forum.
Als VBA Newbe fehlt einem da der Ansatzpunkt...
Und zwar habe ich eine Tabelle (siehe https://www.herber.de/bbs/user/36852.xls
)
in dieser Tabelle steht in der Spalte LAGER nur H´s und später noch F´s...
So, diese sollen zuerst durch TS, NF und TK bei einem H und
durch OG, FK bei einem F ersetzt werden...
Aber jedes Mal als neue Spalte
Also für ein H würden drei neue Zeilen entstehen mit gleichem Inhalt, aber
ebend
TS.....
NF.....
TK usw.
und bei F eben zwei neue Zeilen mit gleichem Inhalt!
Und das dann am besten noch in einer neuen Excel Tabelle schreibt...?!?!
Hoffe das das gut verständlich ist... :( hab schon viel im Forum
gesucht, aber ich finde da nix explizites, was dann auch noch drei bzw. zwei neue Zeilen enstehen lässt.
So das ist mein erstes Problem, da wäre ich schonmal heilfroh wenn mir da jemand zur Seite stehen könnte. Für manche bestimmt Kinderspielchen...
Habt schonmal vielen Dank im Voraus!!!
Gruß...

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub tt() Dim i As Integer, j As Integer Dim arrH, arrF Dim wksZiel As Worksheet Set wksZiel = Sheets(2) arrH = Array("TS", "NF", "TK") arrF = Array("OG", "FK") Application.ScreenUpdating = False With Sheets(1) .Rows(1).Copy wksZiel.Cells(1, 1) For i = 2 To .Cells(65536, 1).End(xlUp).Row If .Cells(i, 1) = "H" Then For j = 0 To UBound(arrH) .Rows(i).Copy wksZiel.Cells(65536, 1).End(xlUp).Offset(1, 0) wksZiel.Cells(65536, 1).End(xlUp) = arrH(j) Next Else For j = 0 To UBound(arrF) .Rows(i).Copy wksZiel.Cells(65536, 1).End(xlUp).Offset(1, 0) wksZiel.Cells(65536, 1).End(xlUp) = arrF(j) Next End If Next i End With Application.ScreenUpdating = True End Sub

Hallo,
ich hoffe, ich habe Deine Problemstellung verstanden. Kopier Dir mal dieses Makro in ein Modul und starte es. Sieh dir dann mal die Tabelle2 an. Voraussetzung: Deine Ursprungstabelle muss Tabelle1 heissen und eine zweite, leere Tabelle2 muss existieren.
In Tabelle2 kannst Du Deine Überschriften in die 1. Zeile bereits eintragen. Die Ergebnisse werden vom Makro ab Zeile 2 eingetragen.


Sub anpassen()
Application.ScreenUpdating = False
Sheets("Tabelle1").Select
Anzahl = [A65536].End(xlUp).Row
'Anzahl der H's und F's ermitteln
For i = 2 To Anzahl
Wert = Cells(i, 1).Value
Select Case Wert
Case Is = "H"
anzahl_h = anzahl_h + 1
Case Is = "F"
anzahl_f = anzahl_f + 1
End Select
Next i
'Zeile, in der die F's beginnen
Beginn_F = anzahl_h + 1
'Zeilen kopieren ....
For i = 2 To anzahl_h
Sheets("Tabelle1").Select
Rows(i).Select
Selection.Copy
'... und 3 mal in Tabelle2 einfügen sowie die H's bzw. F's ersetzen
Sheets("Tabelle2").Select
Anzahl2 = [A65536].End(xlUp).Row
Rows(Anzahl2 + 1).Select
ActiveSheet.Paste
Cells(Anzahl2 + 1, 1).Value = "TS"
Rows(Anzahl2 + 2).Select
ActiveSheet.Paste
Cells(Anzahl2 + 2, 1).Value = "NF"
Rows(Anzahl2 + 3).Select
ActiveSheet.Paste
Cells(Anzahl2 + 3, 1).Value = "TK"
Next i
For i = Beginn_F To Beginn_F + anzahl_f
Sheets("Tabelle1").Select
Rows(i).Select
Selection.Copy
Sheets("Tabelle2").Select
Anzahl2 = [A65536].End(xlUp).Row
Rows(Anzahl2 + 1).Select
ActiveSheet.Paste
Cells(Anzahl2 + 1, 1).Value = "OG"
Rows(Anzahl2 + 2).Select
ActiveSheet.Paste
Cells(Anzahl2 + 2, 1).Value = "FK"
Next i
Range("A1").Select
Sheets("Tabelle1").Select
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "Bin fertig !"
End Sub

Für Feedback sind wir alle dankbar....

Beliebteste Forumthreads (12 Monate)

Spalteninhalt ändern und neu ausgeben!

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalteninhalt ändern und neu ausgeben!

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread