Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 21:55:37
Preiserhöhung über mehrere Jahre berechnen
17.04.2024 20:19:32
Endzeitpunkt berechnen aus d:hh:mm errechnen
17.04.2024 18:57:33
Errinnerungsfunktion
17.04.2024 16:56:58
Stunden addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1796to1800
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1796to1800
1796to1800
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Vertikal mit horizontal vergleichen

Vertikal mit horizontal vergleichen
30.11.2020 13:50:52
Kerem
Hallo zusammen! Ich habe ein Problem bei dem ich eine VBA Lösung brauche.
Unswar: In Tabelle 2 habe ich eine Spalte in der vertikal Namen von Spalten horizontal in Tabelle 1 stehen. (Heißt in Zeile 1 bei Tabelle 1 stehen die Spaltennamen.) Es stehen aber nicht alle Spalten in Tabelle 2 und genau die die nicht darin stehen sollen gelöscht werden (also die gesamte Spalte). Dabei soll das Programm in Tabelle 2 die Spalten in der die Spaltennamen stehen selbst suchen und finden da es vorkommen kann das diese Tabelle verändert wird. Dafür müsste man nur in Zeile 1 der Tabelle 2 das Wort "Spalte" finden und die Zellen darunter dann mit der Zeile 1 der Tabelle 1 vergleichen.
VG Kerem

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Korrektur: Spalte mit Zeile vergleichen.
30.11.2020 15:00:05
Kerem
Vielleicht ein besserer Betreff
AW: Vertikal mit horizontal vergleichen
30.11.2020 15:11:18
Edmund
Hallo Kerem
Da wir nichts über die Struktur Deiner Tabellen wissen, ist es schwer, die passende Lösung zu finden.
Probier mal den folgenden Code aus. Vielleicht passt das ja schon.
Bei Manchem musste ich halt raten.
z.B. wie viele Spalten kann Tabelle2 haben, und sind die durchgehend oder mit Lücken?
Ich bin mal davon ausgegengen, dass da nicht mehr als 1000 Spalten vorkommen werden.
Ebenso bin ich davon ausgegangen, dass in Tabelle2 die Spaltennamen durchgehend untereinander stehen und in Tabelle1 die Spalten durchgehend nebeneinander.
Wenn es anders ist, wird das Makro nicht funktionieren.
Sub makro()
Dim i As Integer
Dim s As Integer
Dim s1 As Integer
Dim z As Integer
s = 1
Do
If Worksheets("Tabelle2").Cells(1, s) = "Spalte" Then
Exit Do
Else
s = s + 1
End If
Loop Until s = 1000
If s = 1000 Then
MsgBox "Keine Überschrift namens Spalte in Tabelle2 gefunden"
Exit Sub
End If
For s1 = 1 To Worksheets("Tabelle1").Cells(1, 1).End(xlToRight).Column
If Worksheets("Tabelle1").Cells(1, s1) = "" Then Exit For
i = 0
For z = 2 To Worksheets("Tabelle2").Cells(1, s).End(xlDown).Row
If Worksheets("Tabelle1").Cells(1, s1) = Worksheets("Tabelle2").Cells(z, s) Then
i = 1
Exit For
End If
Next z
If i = 0 Then Worksheets("Tabelle1").Columns(s1).Delete
Next s1
End Sub
Viele Grüße
Edmund
Anzeige
AW: Vertikal mit horizontal vergleichen
30.11.2020 16:57:03
kero
Hey Edmund!
Danke erstmal, das ist schon sehr so wie es mir vorgestellt habe. Aus irgendeinem Grund werden nicht alle unbraucbaren Spalten gelöscht und wenn das Programm noch einmal ausgeführt wird werden zu viele gelöscht. :/
AW: Vertikal mit horizontal vergleichen
01.12.2020 19:59:38
Edmund
Hallo Kerem
Vielleicht kannst du ja mal die Datei zur Verfügung stellen?
Einen Fehler zu suchen ohne die Struktur deiner Datei zu kennen ist schwierig.
Oder probierst mal das Makro von ralf.
Vielleicht hatte er ja eine genauere Vorstellung von deiner Datei.
Viele Grüße
Edmund
ich hab auch ein bissel Code
30.11.2020 15:20:26
ralf_b
bitte selbst testen.
Sub Spalteneliminieren()
Dim rQbereich As Range
Dim rng As Range, rfund As Range
Dim i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
'** Bereich auslesen
With Sheets("Tabelle2")
Set rQbereich = .Rows("1:1").Resize(, .Cells(1, Columns.Count).End(xlToLeft).Column)
Set rfund = rQbereich.Find(What:="Spalte", LookIn:=xlValues, lookat:=xlWhole)
If Not rfund Is Nothing Then
Else
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
End If
Set rQbereich = .Columns(rfund.Column).Resize(.Cells(Rows.Count, rfund.Column).End(xlUp). _
Row - 1).Offset(1)
End With
With Sheets("Tabelle1")
i = rQbereich.Columns.Count
Do While i > 0
Set rng = rQbereich.Find(What:=.Cells(1, i), LookIn:=xlValues, lookat:=xlWhole)
If Not rng Is Nothing Then
'gefunden
Else
'nicht gefunden
.Columns(i).Delete
End If
i = i - 1
Loop
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige