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.

VBA - Inhalt von Spalten sortieren
#1
Hallo in die Runde,

ich versuche mein Problem 1 (Problem 2 kommt in einem anderen Thema  Blinksmiley ) einmal kurz darzustellen:

In Zeile 1 stehen etwa 350 (aus ca 6000 Einträgen sortierte) Begriffe.
Unter diesen Begriffen sind Werte notiert.
Diesen Code der das vermag habe ich, nachdem meine Bemühungen sämtlich fehl schlugen, von Atilla (minimalst angepasst von mir) freundlicherweise erstellt bekommen. Besten Dank hierfür nocheinmal.

Diese 350 sortierten Begriffe enthalten aber falsche Schreibweisen.
Das bedeutet, dass die Werte unter den falschen Schreibweisen zwar korrekt und damit wichtig, aber nicht richtig zugeordnet sind.

Diese falsche Schreibweisen sind von Hand gesucht, gefunden und der richtigen Schreibweise untergeordnet. Das Ganze ist in einer kleinen Liste aufgestellt.

Jetzt soll ein Code die Werte unter den falschen Schreibweisen kopieren und zu den Werten die schon unter der richtigen Schreibweise stehen hinzu kopieren.

Dann die kompletten Spalten der falschen Schreibweisen entfernen und die so neu entstandene Liste in eine andere Tabelle kopieren.


Ich habe hierzu eine Beispielmappe erstellt. Hängt unten an.
Hoffentlich ist das halbwegs verständlich was ich vorhabe?  :20:

Liebe Grüße
Klaus


Angehängte Dateien
.xlsm   Bsp. aussortieren1.xlsm (Größe: 303,59 KB / Downloads: 6)
Antworten Top
#2
Hallo Klaus,



so,ich denke, dass ich jetzt verstanden habe.


Davon ausgehend, habe ich folgenden Code geschrieben:



Code:
Option Explicit

Sub berichtigen()
 Dim xR, xF
 Dim i As Long, j As Long
 Dim lngZ_Richtig As Long, lngZ_Falsch As Long
 Dim feld
 feld = Sheets("Übersicht").Range("E2:K3")

 With Sheets("Tabelle2")
   For i = 1 To 2
   xR = Application.Match(feld(i, 1), .Rows(1), 0)
   lngZ_Richtig = .Cells(.Rows.Count, xR).End(xlUp).Row
     For j = 2 To 7
       If feld(i, j) <> "" Then
         xF = Application.Match(feld(i, j), .Rows(1), 0)
         If IsNumeric(xF) Then
           lngZ_Falsch = .Cells(.Rows.Count, xF).End(xlUp).Row
           .Range(.Cells(2, xF), .Cells(lngZ_Falsch, xF)).Select
           .Range(.Cells(lngZ_Richtig + 1, xR), .Cells(lngZ_Richtig + lngZ_Falsch - 1, xR)).Value = .Range(.Cells(2, xF), .Cells(lngZ_Falsch, xF)).Value
           .Range(.Cells(lngZ_Richtig + 1, xR), .Cells(lngZ_Richtig + lngZ_Falsch - 1, xR)).Select
           .Columns(xF).Delete
           lngZ_Richtig = lngZ_Richtig + lngZ_Falsch - 1
         End If
       End If
     Next j
   Next i
 End With
End Sub




Vor Ausführung bitte folgendes beachten:

Ich suche direkt in Tabelle2 und sortier die Daten auch direkt dort ein. Spalten von Fehlern werden dort gelöscht.
Dann habe ich den Aufbau der Listen für die Fehlerangaben so aufgebaut:

Arbeitsblatt mit dem Namen 'Übersicht'
 EFGHIJK
1RichtigFehler 1Fehler 2Fehler 3Fehler 4Fehler 5Fehler 6
2Klaus 1Kausz 2Klhaus 3Klauß 4   
3Hans 1Hanz 2Chanz 3Schans 4   
Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

Teste in einer Kopie Deiner Datei!!!
Gruß Atilla
Antworten Top
#3
Hallo Atilla,

besten Dank schonmal Smile

Hab die Liste angepasst und den Code eingebaut. Hoffentlich hab das so richtig verstanden.

Leider kommt nun: "Die Select-Methode des Range Objetkt konnte nicht ausgeführt werden"

Code:
.Range(.Cells(2, xF), .Cells(lngZ_Falsch, xF)).Select

Leider kann ich erst heut Abend nochmal rein schauen.
Muss nun los Sad
Bestimmt hab ich wieder einen Fehler gemacht irgendwo... 
Ich meld mich...

Liebe Grüße
Klaus
Antworten Top
#4
Hallo Klaus,

nö, mein Fehler.

Die Zeile hatte ich zu Testzwecken drin und muss rausgelöscht werden.
Wenn noch andere Zeilen mit Select auftauchen, die auch löschen.
Gruß Atilla
Antworten Top
#5
Guten Abend Atilla,

japp... stimmt, select auskommentiert und es läuft.

Was müsste ich denn dazu fügen, damit man diese Prozedur sozusagen als Option hätte.
Will sagen - wenn in der Liste in der er suchen soll keiner dieser gesuchten Worte vor kommt, dann bricht er hier ab:

Code:
 lngZ_Richtig = .Cells(.Rows.Count, xR).End(xlUp).Row

könnte man das, wenn keines der Worte dabei ist, so machen, dass das er das übergeht?

Liebe Grüße
Klaus
Antworten Top
#6
Hallo Klaus,

wollte ich eigentlich einbauen, aber als ich gesehen habe, dass Du Datengültigkeit in der Zelle nutzt, ging ich davon aus, dass diese auch richtig eingesetzt wird.
Das hieße in der Zelle wäre ein Wert, welcher immer vorhanden ist.

Aber sind nur zwei Zeilen mehr Code:


Code:
Sub berichtigen()
 Dim xR, xF
 Dim i As Long, j As Long
 Dim lngZ_Richtig As Long, lngZ_Falsch As Long
 Dim feld
 feld = Sheets("Übersicht").Range("E2:K3")

 With Sheets("Tabelle2")
   For i = 1 To 2
    xR = Application.Match(feld(i, 1), .Rows(1), 0)
    If IsNumeric(xR) Then
      lngZ_Richtig = .Cells(.Rows.Count, xR).End(xlUp).Row
      For j = 2 To 7
        If feld(i, j) <> "" Then
          xF = Application.Match(feld(i, j), .Rows(1), 0)
          If IsNumeric(xF) Then
            lngZ_Falsch = .Cells(.Rows.Count, xF).End(xlUp).Row
            .Range(.Cells(lngZ_Richtig + 1, xR), .Cells(lngZ_Richtig + lngZ_Falsch - 1, xR)).Value = .Range(.Cells(2, xF), .Cells(lngZ_Falsch, xF)).Value
            .Range(.Cells(lngZ_Richtig + 1, xR), .Cells(lngZ_Richtig + lngZ_Falsch - 1, xR)).Select
            .Columns(xF).Delete
            lngZ_Richtig = lngZ_Richtig + lngZ_Falsch - 1
          End If
        End If
      Next j
    End If
   Next i
 End With
End Sub
Gruß Atilla
Antworten Top
#7
ahhhhhh.... jawoll, jetzt ham was Smile

Klappt wunderbar. 

herzlichen Dank  :19:
Antworten Top
#8
Ich muss doch nochmal "kurz" was nachhaken  :20: 


Kann man verhindern, dass bei Übertragung der Daten nach Tabelle2 die Formatierung in Tabelle2 gelöscht wird? 
(oder diese Formatierung nach Übertragung neu setzen? Das was ich per Recorder mitschneide, funktioniert aber wenn ich das in den Code verbaue im Ablauf dann nicht)

Ich möchte eine Bedingte Formatierung (wenn Zelle nicht leer - dann Rahmen und grau) anlegen.
Soll fürs drucken übersichtlicher aussehen...

Derzeit löscht der Code aber diese Formatierung stets wieder.

Liebe Grüße
Klaus
Antworten Top
#9
Hallo Klaus,

ich glaube, dass es keine gute Idee ist in so einer großen Datei noch in dem Umfang Bedingte Formatierung zu nutzen.

Aber wenn Du es unbedingt machen möchtest, dann kopier doch die "fertige" Tabelle2 in eine weitere Tabelle in der die Bedingte Formatierung eingesetzt wird.
Das gibt noch mehr Daten!!! Wenn möglich, dann in Tabelle2 löschen.

Im Code kannst Du nichts anpassen, um das zu verhindern. Denn der Code löscht ganze Spalten, somit auch Formatierungen.
Gruß Atilla
Antworten Top
#10
Oh Gott Atilla,
manchmal bin ich aber auch was doof...
na klar... da hätte ich auch selber drauf kommen können.

Danke für den Tipp Smile

Liebe Grüße
Klaus
Antworten Top


Gehe zu:


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