Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Transponieren
#1
Hallo

ich möchte Zellen mit einen bestimmten Text Transponieren. Mit der ganzen Zeile oder einzelnen Zellen klappt es. Es sind aber (schon sortiert) mehrere Zellen mit gleichen Inhalt. Wie kann ich die nebeneinder liegenden Zellen zum Transponieren markieren ?

Für einen Tip schon mal Danke
---------------------------------------------------------------------
Code:
Sub Makro2()
Dim zeLLe As Range, Bereich As Range

    Cells.Find(What:="ab", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveCell.Offset(0, -21).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

   Cells.Find(What:="yz", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveCell.Offset(0, -21).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
End Sub

Code strukturiert dargestellt durch 3. Button von rechts im Beitragsformular: #
photo Raute_zps3ee56209.jpg
[Bild: smilie.php?smile_ID=1810]
Antworten Top
#2
Hallo,

stell bitte eine Beispieltabelle ein.
Man sollte vorher und nachher ersehen können.
Gruß Atilla
Antworten Top
#3
Hallo,

die Zellen mit gleichen Inhalt sollen transponiert werden.
Tabelle1

ABCDEFGHIJKLMN
1
2abyzabababyzyzyzyz
3abyz
4abyz
5yz
6
7vorher
8
9
10Wunsch
11

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Antworten Top
#4
Hallo,

leider sind das zu dürftige Angaben. Ich gehe auch davon aus, dass Die Daten bei Dir an anderer Stelle stehen. Da Du im Code mit Activecell arbeitest, kann auch aus dem Code heraus nicht abgeleitet werden, wo sie stehen und wo sie hinkopiert werden sollen.

Deswegen habe ich Deinen Code genommen und ohne jede Fehlerabfragen die Fundstellen in A1 und C1 transponiert.

Code:
Option Explicit

Sub Makro2()
   Dim zeLLe As Range, Bereich As Range
   Dim Anzahl As Long
   Set zeLLe = Cells.Find(What:="ab", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
   Anzahl = Application.CountIf(Rows(zeLLe.Row), zeLLe) - 1
   Set Bereich = Range(Cells(zeLLe.Row, zeLLe.Column), Cells(zeLLe.Row, zeLLe.Column + Anzahl))
    Bereich.Copy
    Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

   Set zeLLe = Cells.Find(What:="yz", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
   Anzahl = Application.CountIf(Rows(zeLLe.Row), zeLLe) - 1
   Set Bereich = Range(Cells(zeLLe.Row, zeLLe.Column), Cells(zeLLe.Row, zeLLe.Column + Anzahl))
   Bereich.Copy
   Range("C1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
      False, Transpose:=True
End Sub
Gruß Atilla
Antworten Top
#5
Hallo Atilla,

genau, das ist die Lösung. Vielen Dank.
Antworten Top
#6
Hallo Atilla,

leider war meine Freude zu früh. Wenn ich F2 aktiviere und dann Makro ausführe alles ok.
Wenn ich F7 aktiviere und Makro ausführe dann werden die Zellen mit ("ab")aus Zeile 7 richtig übernommen,
aber auch die Zellen aus Zeile 2 (yz). Es soll nur die Zeile welche aktiviert ist bearbeitet werden.

Tabelle1

ABCDEFGHIJKLMNO
1ABCDEFGHIJKLMN
21
32abyzabababyzyzyzyz
43abyz
54abyz
65yz
76
87ababvorher
98
109
1110Wunsch
1211

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Antworten Top
#7
Hi,

(05.01.2015, 20:16)sundw1 schrieb: Es soll nur die Zeile welche aktiviert ist bearbeitet werden.

für eine korrekte Lösung ist es vorteilhaft, die Aufgabe gleich am Anfang komplett zu stellen.
Antworten Top
#8
Hallo,

ich hatte mich schon gewundert, dass da keine Fortsetzung kommt.
Und es gibt immer nur "ab" und "yz" in der Zeile?
Kommen immer beide Suchbegriffe vor oder kann eines oder keins vorhanden sein?

Mit den dürftigen Angaben kann man leider nur eine dürftige Lösung vorschlagen.
Unten der Code hat jetzt einige Einschränkungen.
Es wird immer ab Spalte 6 in der aktiven Zeile nach den zwei benannten Werten gesucht.
Bei Fund wird der Erste in Spalte A ab der aktiven Zeile und der Zweite in C ab der aktiven Zeile transponiert.

Code:
Sub Makro2()
   Dim lngZ As Long, lngs As Long
   lngZ = ActiveCell.Row
   lngs = 6
   Dim zeLLe As Range, Bereich As Range
   Dim Anzahl As Long
   Set zeLLe = Range(Cells(lngZ, lngs), Cells(lngs, Columns.Count)).Find(What:="ab", After:=Range("F" & lngs), LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
   If Not zeLLe Is Nothing Then
      Anzahl = Application.CountIf(Range(Cells(lngZ, lngs), Cells(lngs, Columns.Count)), zeLLe) - 1
      Range(Cells(zeLLe.Row, zeLLe.Column), Cells(zeLLe.Row, zeLLe.Column + Anzahl)).Copy
       Range("A" & lngZ).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
           False, Transpose:=True
          
   End If
  
   Set zeLLe = Range(Cells(lngZ, lngs), Cells(lngs, Columns.Count)).Find(What:="yz", After:=Range("F" & lngs), LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
   If Not zeLLe Is Nothing Then
      Anzahl = Application.CountIf(Range(Cells(lngZ, lngs), Cells(lngs, Columns.Count)), zeLLe) - 1
      Range(Cells(zeLLe.Row, zeLLe.Column), Cells(zeLLe.Row, zeLLe.Column + Anzahl)).Copy
       Range("C" & lngZ).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
           False, Transpose:=True
      Set zeLLe = Nothing
   End If
End Sub

So einen Code kann man dann z.B mit Doppelklick in eine Zelle starten.

Den obigen Code und folgenden einfach in das Code Modul der Tabelle einfügen:

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Call Makro2
   Cancel = True
End Sub
Gruß Atilla
Antworten Top
#9
Hallo Atilla,

da kommt ein alter Mann aus dem Staunen nicht mehr raus.

Vielen Dank, jetzt klappt es
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste