Texte löschen und transponieren - VBA

Forumthread: Texte löschen und transponieren - VBA

20.09.2021 07:22:30

Christian

Hallo,
ich wünsche euch einen guten morgen und einen guten Start in die Woche.
Ich möchte euch bitten, wenn es geht mir mit einem Makro auszuhelfen, was macht, was ich in meiner Bsp. Mappe erklärt habe:
https://www.herber.de/bbs/user/148154.xlsx
Ich bitte um ein Makro, dass automatisch startet, sobald ich Texte in Spalte B einfüge.
Ich weiß da gibt es auch sicher Lösungen ohne VBA, allerdings, wenn man mehrere tausend mal etwas einfügen will, ist es doch eine ziemliche Erleichterung , wenn möglichst viel automatisch abläuft, daher meine Bitte um eine VBA Lösung.
Viele Grüße
Christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Texte löschen und transponieren - VBA

20.09.2021 08:45:30

UweD

Hallo
hier mal ein Code (manuell starten, ggf als Tastenkombi festlege)


Sub Christian()
Dim LR As Integer, Z1 As Integer, S1 As Integer, i As Integer
Dim TMP As String, SP As Integer
Z1 = 3 'erster Text in Zeile 3
S1 = 2 'Daten Spalte B
SP = S1 + 1 'Zielspalte
Application.ScreenUpdating = False
With Sheets("Tabelle1")
LR = .Cells(.Rows.Count, S1).End(xlUp).Row 'letzte Zeile der Spalte
For i = Z1 To LR Step 4
TMP = .Cells(i, S1)
If WorksheetFunction.CountIf(.Rows(1), TMP) = 0 Then
.Cells(1, SP) = TMP
SP = SP + 1
End If
Next
.Cells(1, S1).Resize(LR, 1).ClearContents
End With
End Sub

LG UweD

AW: Texte löschen und transponieren - VBA

20.09.2021 09:14:56

Christian

Hallo Uwe,
erst einmal danke für deine Mühe. Aber ich fürchte mir fehlen die VBA Kenntnisse um ihn so zu ändern, dass er dem entsprihcht was ich wollte.
Was zum Bsp. fehlt ist
1. dass es von alleine startet, sobald ich in Spalte B Texte einfüge
2. das es sich nicht auf B3 als Startzelle festlegt, sondern er auf alles reagiert, was ich in Spalte B einfüge, auch wenn die erste Zelle eine andere als B3 ist.
3. da gab es wohl ein Misverständnis, mit dem 3. 7. 11. 15. Text war der 3. 7. 11. 15. Text gemeint, den ich eingefügt hatte, nicht die Zellen B3, B7, B11, B15 usw., da ich ja an beliebigen Stellen in Spalte B einfügen möchte.
4. (ok, das ging nicht direkt aus der Bsp datei hervor, gebe ich zu), die transponierten Texte sollten in der ersten Zeile eingefügt werden, in die ich zuvor die Texte eingefügt habe. Dein Makro schreibt sie in Zeile 1.
Es tut mir leid, dass da jetzt so Umstände entstehen. Ich hate gedacht meine Bsp. Datei wäre eindeutig gewesen. Anscheinend fehlte mir das Excel Wissen um zu erkennen, wie man es sonst noch hätte deuten können.
Gruß
Christian

AW: Texte löschen und transponieren - VBA

20.09.2021 09:58:55

UweD

Hallo nochmal
dann versuch es so
Einmal
- Rechtsclick auf den Tabellenblattreiter
- Code anzeigen
- Den Code einfügen


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Const APPNAME = "Worksheet_Change"
Dim RNG As Range, TMP As String
Dim Z1 As Integer, Sp As Integer, i As Long
'Nur Spalte B berücksichtigen
Set RNG = Intersect(Columns(2), Target)
Z1 = 3 'StartZeile im Bereich
If Not RNG Is Nothing Then
If WorksheetFunction.CountBlank(RNG) = RNG.Count Then Exit Sub ' falls nur Leerzellen
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = Z1 To RNG.Count Step 4
TMP = Target.Cells(i) 'der aktuelle Text
'Zählen, ob Text schon im Zielbereich vorhanden idt
If WorksheetFunction.CountIf(Target.Cells(1).Resize(1, Sp + 1), TMP) = 0 Then
'wenn neu, dann anfügen
Target.Cells(1).Offset(0, Sp) = TMP
Sp = Sp + 1
End If
Next
'Einfügebereich löschen, außer erste Zelle
RNG.Offset(1, 0).Resize(RNG.Count - 1).ClearContents
Application.EnableEvents = True
End If
'*** Fehlerbehandlung
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number  0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Wenn du jetzt was in B einfügst, wird ab der ersten Zelle des Einfügebereichs abgearbeitet.
Auch beginnt das Ergebnis dann in der ersten Zelle.
LG UweD

AW: Texte löschen und transponieren - VBA

20.09.2021 11:16:16

Christian

Hallo Uwe,
das scheint soweit zu funktionieren. Vielen Dank.
Ich hätte allerdings vielleicht noch 2 Bitten, sorry das ist mir wirklich gerade erst beim Testen aufgefallen, dass es sinnvoll wäre.
Zum einen, dass auch die zweite der eingefügten Zellen erhalten bleibt, nicht nur die 3. 7. 11. 15., also in Zukunft Zeile 2, 3, 7, 11, 15, 19 usw.
Zum anderen, das wenn ich mehr als 132 Zellen eingefügt habe, das das Makro dann unter der Zeile mit der Ausgabe eine Leerzeile einfügt.
Ich hoffe das war es dann wirklich.
Gruß
Christian

AW: Texte löschen und transponieren - VBA

20.09.2021 11:40:14

UweD

Hi
so?


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Const APPNAME = "Worksheet_Change"
Dim RNG As Range, TMP As String, MMAx As Integer
Dim Z0 As Integer, Z1 As Integer, Sp As Integer, i As Long
'Nur Spalte B berücksichtigen
Set RNG = Intersect(Columns(2), Target)
Z0 = 2 'Erster Durchlauf aus 2. Wert
Z1 = 3 'StartZeile im Bereich
MMAx = 132
If Not RNG Is Nothing Then
If WorksheetFunction.CountBlank(RNG) = RNG.Count Then Exit Sub ' falls nur Leerzellen
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = Z0 To RNG.Count Step 4
TMP = Target.Cells(i) 'der aktuelle Text
If i = Z0 Then i = Z0 - 3 ' von 2 auf 3 ändern
'Zählen, ob Text schon im Zielbereich vorhanden idt
If WorksheetFunction.CountIf(Target.Cells(1).Resize(1, Sp + 1), TMP) = 0 Then
'wenn neu, dann anfügen
Target.Cells(1).Offset(0, Sp) = TMP
Sp = Sp + 1
End If
Next
'Einfügebereich löschen, außer erste Zelle
RNG.Offset(1, 0).Resize(RNG.Count - 1).ClearContents
'Leerzeile
If RNG.Count > MMAx Then
Rows(Target.Row + 1).Insert
End If
Application.EnableEvents = True
End If
'*** Fehlerbehandlung
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number  0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD

AW: Texte löschen und transponieren - VBA

20.09.2021 11:43:27

Christian

Hallo Uwe,
also dann hätte ich noch hier das eine, da das andere zu ändern... ich hoffe du hast den Rest des Tages noch nichts vor...
Nein im Ernst, sieht soweit alles gut aus und funktioniert.
Vielen Dank für die Geduld und die Mühe
Christian

Danke für die Rückmeldung (owT)

20.09.2021 11:47:02

UweD

AW: Texte löschen und transponieren - VBA

20.09.2021 10:01:01

ralf_b

das klingt so ein wenig nach dem hier sehr bekannten Oraculix mit seiner Filmdatenbank. Wenn du es nicht selbst bist, dann wäre es sicher ne gute Idee sich mit ihm kurzzuschließen. Könnte doch sein das er deine(vielleicht noch kommenden) Probleme schon gelöst hat.

AW: Texte löschen und transponieren - VBA

20.09.2021 11:05:18

Christian

Hallo Ralf,
du hast in sofern recht, dass es um Filme geht, jedoch sind Oraculix und ich 2 verschiedene Personen, die bislang keinen Kontakt hatten. Aber danke für den Hinweis.
Gruß
Christian

Beliebteste Forumthreads (12 Monate)

Texte löschen und transponieren - VBA

Forumthread: Texte löschen und transponieren - VBA

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread