ich versuche mein Problem 1 (Problem 2 kommt in einem anderen Thema ) 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:
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:
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:
31.01.2017, 00:55 (Dieser Beitrag wurde zuletzt bearbeitet: 31.01.2017, 00:55 von atilla.)
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
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.
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.
) einmal kurz darzustellen:
