Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1572to1576
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
Inhaltsverzeichnis

UDF stößt an ihre Grenze (Alternative?)

UDF stößt an ihre Grenze (Alternative?)
11.08.2017 19:43:44
Jenny
Hallöchen,
hoffe da hat jemand eine Idee, nachstehend die UDF.
Es scheint wohl eine Grenze zu geben, was maximale Zeichen pro Zelle anbelangt, diese wird jedenfalls in 2 meiner Zeilen überschritten.
Wäre nett wenn ihr mir helft.
Function Verketten2(ByRef bereich As Range, Trennzeichen As String) As String
Dim rng As Range
For Each rng In bereich
If rng  "" Then
Verketten2 = Verketten2 & rng & Trennzeichen
End If
Next
If Len(Verketten2) > 0 Then _
Verketten2 = Left(Verketten2, Len(Verketten2) - Len(Trennzeichen))
End Function
Gruß
Jenny

53
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: wieviele?
11.08.2017 20:05:49
Gerd
Hallo Jenny,
wie lang ist dein String?
Function Verketten88(ByRef bereich As Range, Trennzeichen As String) As Long
Dim rng As Range
For Each rng In bereich
If rng  "" Then
Verketten88 = Verketten88 & rng & Trennzeichen
End If
Next
If Len(Verketten88) > 0 Then _
Verketten88 = Len(Verketten88) - Len(Trennzeichen)
End Function
Gruß Gerd
AW: wieviele?
11.08.2017 20:07:02
Jenny
meinst du Spalten die zusammengefasst werden oder Zeichen?
Gruß
Jenny
AW: UDF stößt an ihre Grenze (Alternative?)
11.08.2017 20:16:22
Christian
Hi,
nicht die Funktion kommt an Ihre Grenzen, sondern Excel.
Nach meinem Versuch (akt. Excel Version) ist bei 32.767 Zeichen pro Zelle Schluß.
BG, CH
Anzeige
AW: UDF stößt an ihre Grenze (Alternative?)
11.08.2017 20:32:23
Jenny
Das war ja auch meine Vermutung,
da das durchaus an diese Grenze kommen kann.
Daher ja meine Frage ob es eine Alternative gibt,
z.B. in dem dann automatisch in diesen Zeilen eine 2. Formel gemacht wird, in der dann der Rest steht.
Ohne den Text aus einer einzelnen Zelle auf 2 Formeln aufzuteilen.
Gruß
Jenny
AW: UDF stößt an ihre Grenze (Alternative?)
12.08.2017 00:26:34
Tino
Hallo,
mal eine andere Frage, was hast du den mit diesen langen Text vor?
Der ist bestimmt nicht zur Darstellung vorgesehen!?
Gruß Tino
AW: UDF stößt an ihre Grenze (Alternative?)
12.08.2017 07:59:34
Jenny
Hallo Tino,
nein natürlich nicht, habe vor durch eine andere Formel noch Text anzufügen und dann wieder aufzusplitten.
Was ich vom Prinzip her vorhabe ist folgendes
Spalte D ist in 2 Teile geteilt, der erste Teil von D1 bis D15118 ist leer, in D15119 bis D16077 stehen Texte.
Wobei das jetzt eine Momentaufnahme ist, wenn ich das ganze später erneut mache, können das auch andere Bereiche sein.
Diese Texte sollen nun jeweils ans Ende einer Zeile im ersten Bereich kopiert werden, und zwar in die Zeile, in der die Texte in Spalte A und E identisch sind zu der Zeile in der der Text steht. (Das Ende einer Zeile ist in jedem Fall Spalte M oder folgende).
Bsp: Der Text in D15119 soll nach O6227 kopiert werden, da A15119 = A6227, E15119 = E6227 und in M6227 und N6227 bereits etwas steht.
Bsp 2: Der Text in D15120 soll nach N6228 kopiert werden, da A15120 = A6228, E15120 = E6228 und in M6228 bereits etwas steht. (N6228 war leer)
Bsp 3: Gibt es keine Übereinstimmung in den Spalten A und E soll der Text in Spalte M derselben Zeile geschrieben werden.
Die Verketten Formel war nur ein Mittel zum Zweck, damit man das ohne Makro machen kann.
Gruß
Jenny
Ach bevor ich es vergesse, es kommt immer nur eine Zeile in Frage um den Text zu kopieren.
Anzeige
Bsp Datei
12.08.2017 08:43:35
Jenny
Hallo Tino,
hoffe ich habe eine halbwegs vernünftige Bsp Datei hinbekommen
Erklärungen
Schwarz ist der Ist-Zustand, Rot der Soll-Zustand
die Texte in Spalte D sollen ans Ende einer vorherigen Zeile gestellt werden, sofern es die Kombination aus den Texten in Spalte A und E bereits gab. Innerhalb des ersten Bereiches (ohne Texte in Spalte D)
kommt jede Kombination aus A und E nur einmal vor.
Im zweiten Bereich können sich die Kombinationen wie ihr seht durchaus wiederholen. Es soll weiterhin jeder Text in Spalte D in die Zeile kopiert werden, in der die Kombination aus A und E das erste mal auftritt.
In Zeile 14 steht eine Kombination aus A und E, die noch nie zuvor aufgetreten ist, daher soll D14 nach M14 kopiert werden.
Im zweiten Teil (mit Texten in Spalte D) ist der Bereich Spalte M ff. grundsätzlich leer.
Da ich später sowieso Duplikate entferne, ist es egal, was mit den jetzt leeren Zellen in Spalte M passiert.
https://www.herber.de/bbs/user/115418.xlsx
Anzeige
AW: UDF stößt an ihre Grenze (Alternative?)
12.08.2017 13:16:46
Christian
Hallo Jenny,
hier eine zusammengeschraubte UDF als Arrray-Formel, die den verketteten String auf zwei nebeneinanderliegenden Zellen zb.(A4,B4)aufteilen kann und zwar so, dass in der ersten Zelle die maximal mögliche Anzahl der Zeichen steht, und in Zelle rechts davon der darüber hinaus gehende Teil des Strings.
Beachte das diese UDF als Array-Formel eingegeben werden muss. Siehe dazu: http://www.cpearson.com/excel/arrayformulas.aspx. Beide Zellen sind dazu zum markieren, bevor die Formeleingabe erfolgt.
UDF bitte vorsichtig antesten!
Btw, die Beispieldatei und die Problembeschreibung die du gepostet hast, ist - zumindest für mich - absolut unverständlich. Du solltest vielleicht ein bisschen mehr Mühe in klare Testdaten und eine verständliche Anforderungsbeschreibung investieren.
VG, Ch.
Function Verketten3(ByRef bereich As Range, Trennzeichen As String) As Variant
Dim rng As Range
Dim arr(1) As String
Dim maxL As Long
maxL = 32767
For Each rng In bereich
If rng  "" Then
Verketten3 = Verketten3 & rng & Trennzeichen
End If
Next
If Len(Verketten3) > 0 Then
If Len(Verketten3) > maxL Then
arr(0) = Left(Verketten3, Len(Verketten3) - _
Len(Trennzeichen) - (Len(Verketten3) - maxL - 1))
arr(1) = Right((Left(Verketten3, Len(Verketten3) - _
Len(Trennzeichen))), Len(Left(Verketten3, _
(Len(Verketten3) - Len(Trennzeichen)) - maxL)))
Else
arr(0) = Left(Verketten3, Len(Verketten3) - Len(Trennzeichen))
End If
Verketten3 = arr
End If
End Function

Anzeige
AW: UDF stößt an ihre Grenze (Alternative?)
12.08.2017 13:55:58
Jenny
Hallo Christian,
das Makro stellt mich auf jedenfall vor das Problem, dass wenn die Zellen direkt nebeneinander liegen, dass ich dann die linke der Zellen nicht wieder mit der Text in Spalten Funktion aufteilen kann, ohne die rechte zu überschreiben.
Ich versuche mal anders zu beschreiben, was ich bislang gemacht habe.
Ich habe den freien Bereich in Spalte D mit der Formel =VERKETTEN2(M1:OR1;";") gefüllt und Werte eingefügt.
Und dann das gemacht, was damals Daniel mir in diesem Thread hier geraten hat:
https://www.herber.de/cgi-bin/callthread.pl?index=1495415
nur das aus seiner Formel dank Umstrukturierung der Tabelle =D1&WENN(UND(A1=A2;E1=E2);";"&M2;"")
geworden ist.
Nur das geht jetzt nicht mehr wegen dem Problem mit den Zeichen pro Zelle.
Kannst du es jetzt nachvollziehen?
Gruß
Jenny
Anzeige
AW: UDF stößt an ihre Grenze (Alternative?)
12.08.2017 14:22:18
Christian
.... verstehe ich schon, nur die UDF mit der Split-Funktionalität wird immer nur in zwei nebeneinanderliegende Zellen schreiben können. Eine Konstruktion mit Hilfsspalten ist deshalb in Betracht zu ziehen.
Alternativ kann man deine Zielstellung vermutlich auch schön über ein nettes kleines Makro lösen.
VG, Ch.
AW: UDF stößt an ihre Grenze (Alternative?)
12.08.2017 14:26:17
Jenny
Hallo Christian, wie gesagt ich hatte nichts anderes vor, als die UDF zu nutzen, um die Spalte D wieder komplett zu füllen damit es wieder so aussieht wie in dem alten Beispiel aus dem uralt Thread und dann das zu machen, was in dem alten Thread steht.
Nur leider macht die UDF nicht mehr mit.
Hoffe du verstehst jetzt was ich meine und für was ich die Alternative suche.
Bekommst du das mit dem Makro hin?
LG
Jenny
Anzeige
AW: UDF stößt an ihre Grenze (Alternative?)
12.08.2017 14:23:00
Jenny
habe als allererstes damals das gemacht was in dem alten Beitrag steht.
Die UDF kam dann später dazu, um das ganze wiederholen zu können, ohne alte Einträge zu verlieren.
Gruß
Jenny
AW: UDF stößt an ihre Grenze (Alternative?)
12.08.2017 16:15:46
Daniel
Hi
wenn dein Text länger werden kann, als die maximale Anzahl der Zeichen in einer Zelle zuläßt dann probiere mal diese UDF, um die Texte zusammen zu fassen:

Function Verketten3(ByRef bereich As Range, _
Trennzeichen As String, _
Optional PosNr As Long = 1, _
Optional MaxLänge As Long = 32768) As String
Dim Erg() As String
Dim rng As Range
Dim i As Long
i = 0
ReDim Erg(i)
For Each rng In bereich
If rng  "" Then
If Len(Erg(i) & Trennzeichen & rng) > MaxLänge Then
i = i + 1
If i = PosNr Then Exit For
ReDim Preserve Erg(i)
End If
Erg(i) = Erg(i) & Trennzeichen & rng
End If
Next
If (PosNr - 1) > i Then
Verketten3 = ""
Else
Verketten3 = Mid(Erg(PosNr - 1), Len(Trennzeichen) + 1)
End If
End Function
hierbei kannst du zwei weiter Parameter angeben:
der 4. Parameter ist maximal zulässige Länge eines Textes.
Wenn du nichts angibst, wird die maximale Länge von 32768 Zeichen eingesetzt
der 3. Parameter ist die Nr des Textteils, der Ausggegeben werden soll.
Die Funktion funktioniert jetzt so:
wird der Text länger als die erlaubte Länge, dann wir er in mehrere Teile gesplittet und über die Angabe der Positionsnummer im 3. Parameter kannst du dir aussuchen, welcher Teil dir ausgegeben werden soll.
dh in die erste Zelle kommt:
=Verketten3(deinZellbereich;"|";1)
in die zweite Zelle kommt
=Verketten3(deinZellbereich;"|";2)
das hat gebenüber der Matrixformel von Christian den Vorteil, dass du dir selber aussuchen kannst, in welche Zelle der zweite Textteil geschrieben werden soll.
Gurß Daniel
Anzeige
AW: UDF stößt an ihre Grenze (Alternative?)
12.08.2017 16:25:02
Jenny
Hallo Daniel,
ich muss mal so dumm fragen. Aber gibt es nicht direkt die Möglichkeit, die Verketten Formel ganz zu umgehen?
Also mithilfe eines Makros das schaut, was ist die erste Zeile mit Inhalt in Spalte D, schaut was steht in dieser Zeile in Spalte A und E.
Das erste Auftreten der beiden Texte in Spalte A und E in der Tabelle sucht.
Und dann den Text ans Ende dieser Zeile schreibt.
Dann dasselbe mit dem 2. Text in Spalte D
dann der 3. Text in Spalte D
bis zum Ende.
Gruß
Jenny
AW: UDF stößt an ihre Grenze (Alternative?)
12.08.2017 16:33:26
Daniel
Hi
sorry, aber da gehts mir wir den Kollegen.
Ich verstehe deine Beschreibung nicht und deine Beispieldatei hilft auch nicht weiter.
Gruß Daniel
Anzeige
AW: UDF stößt an ihre Grenze (Alternative?)
12.08.2017 17:00:40
Jenny
Hallo Daniel.
ich versuche es nochmal.
https://www.herber.de/cgi-bin/callthread.pl?index=1495415
den Rat hattest du mir zu im Thread genanntem Zweck damals gegeben. und das habe ich immer noch vor.
Das einzige, was sich daran geändert hat, ist dass da noch ein paar Spalten hinzugekommen sind, die allerdings mit dem Fall hier nichts zu tun haben.
Bzw. die Formel die du da genannt hast steht jetzt nicht mehr in Spalte G sondern in Spalte M.
und heißt
=D1&WENN(UND(A1=A2;E1=E2);";"&M2;""). Aber es wird immer noch dasselbe gemacht wie damals.
Dann habe ich mit der Tabelle weiter gearbeitet und es sind neue Datensätze dazugekommen, mit neuen Texten in Spalte D. Mit denen wollte ich dann dasselbe wie zuvor machen, allerdings ohne die alten Einträge in Spalte M ff. zu verlieren.
Daher dann die Verketten Formel, die fügt alle Einträge in den Zellen von Spalte M aufsteigend wieder zusammen.
Und damit habe ich wieder dieselbe Ausgangslage wie in deinem Thread damals, nämlich nur einen Text pro Zeile in Spalte D anstatt viele einzelne in den Spalten M ff. und kann das aus dem 1. Thread 1:1 wiederholen.
Jedenfalls solange die 32Tsd und noch was Zeichen nicht überschritten waren.
Anzeige
AW: UDF stößt an ihre Grenze (Alternative?)
12.08.2017 18:19:45
Jenny
Hallo Daniel,
zu diesem Makro. Auf dem Weg ist es sicherlich machbar, aber umständlicher als einen Teil der Texte dauerhaft auszulagern, sodass die Grenze nicht überschritten wird und den herkömmlichen Weg zu nehmen.
Ich hatte noch eine Idee, dir klarzumachen wass ich will.
Den damaligen Thread hattest du ja verstanden.
https://www.herber.de/bbs/user/115425.xlsm
In der jetzigen Bsp Datei Blatt "vorher" ist der rote Teil das Ergabnis von dem was ich im damaligen Thread gemacht habe.
Jetzt sind neue Datensätze (Blauer Teil) hinzugekommen und ich möchte dasselbe machen, wie im alten Thread, die Duplikate in A und E entfernen und stattdessen die Texte in Spalte D in den Spalten ab M auflisten.
Damit die bestehenden Texte in den Spalten M ff. nicht verloren gehen, habe ich im Blatt "Zwischenschritt" in D1:D4 die UDF Verketten2 ausgeführt, die Werte eingefügt und den Inhalt der Spalten M ff. gelöscht.
Im Blatt "nachher" bin ich dann hingegangen, habe dasselbe erneut gemacht, wie im alten Thread beschrieben,
habe nach A und E sortiert, in Spalte M die Formel =D1&WENN(UND(A1=A2;E1=E2);";"&M2;"") genutzt, die Werte eingefügt, die Funktion Text in Spalten mit Semikolon als Trennzeichen angewandt, mit den Kriterien A und E Duplikate entfernt und den Inhalt der Spalte D gelöscht.
Mit anderen Worten, ich habe mit der Tabelle Zwischenschritt exakt dasselbe wie damals im alten Thread gemacht.
Und ich will auch weiterhin dasselbe tun, nur dass für die Verketten2 Formel in manchen Zeilen zuviel Text da ist und ich deshalb eine andere Lösung brauche.
Gruß
Jenny
AW: hatte vergessen zu speichern
13.08.2017 00:06:14
Christian
Jenny,
hier mal ein Makro,das auf deine erste Beispieldatei ("In Zeile 14 steht eine Kombination aus A und E, die noch nie zuvor aufgetreten ist, daher soll D14 nach M14 kopiert werden.") zugeschnitten ist...

Sub xFiles()
' Tabellenname > ggf. Anpassen
With ThisWorkbook.Worksheets("Tabelle1")
' Datenbereich > ggf. anpassen!
Dim rng As Range
Set rng = .Range("A1:E16")
' Spalte ab der die ermittelten Wert eingetragen werden sollen (M)
Dim lTargetColum As Long
lTargetColum = 13
Dim lColumnKey1 As Long
Dim lColumnKey2 As Long
Dim lColumnValue As Long
' Spaltendefinitionen
lColumnKey1 = 1  '(A)
lColumnKey2 = 5  '(E)
lColumnValue = 4 '(D)
Dim ArrayList01 As New ArrayList
Set ArrayList01 = CreateObject("system.collections.arraylist")
Dim strKeyAE As String
Dim strValueD As String
' Zeile in der Range
Dim r As Variant
Dim x(1) As String
' Alle Zeilen in a1 : E16 durchlaufen
For Each r In rng.Rows
' Wert aus jew. Zeile und Spalte D
strValueD = r.Cells(1, lColumnValue).Value
' Nur die Zeilen verarbeiten, in denen Spalte 4 (D) nicht leer ist
If Not strValueD = "" Then
' Schlüssel aus Spalte 1(A) und 5 (E) bilden
strKeyAE = r.Cells(1, lColumnKey1).Value & r.Cells(1, lColumnKey2)
' Schlüssel und Wert dem Array x zuweisen
x(0) = strKeyAE
x(1) = strValueD
' Array einer ArrayList ArrayList01 zuweisen
ArrayList01.Add x
End If
Next r
' Range nochmal durchlaufen
For Each r In rng.Rows
c = 0
strKeyAE = r.Cells(1, lColumnKey1).Value & r.Cells(1, lColumnKey2)
For Each j In ArrayList01
If strKeyAE = j(0) Then
r.Cells(1, lTargetColum + c).Value = j(1)
c = c + 1
End If
Next j
Next r
End With
End Sub
VG, Ch.
AW: hatte vergessen zu speichern
13.08.2017 11:29:02
Jenny
Hallo Christian,
erstmal vielen Dank.
Allerdings meint Excel Fehler beim Kompilieren. Benutzerdefinierter Typ nicht definiert
und markiert dann ArrayList01 As New ArrayList
Hast du denn die aktuellste Bsp Datei genommen? Weil da steht bei mir die Zeile die komplett neu ist in Zeile 18, nicht in Zeile 14.
Außerdem noch eine Frage, ob noch ein paar Dinge möglich wären
1. in der Zeile Set rng = .Range("A1:E18") ist es möglich dass das Makro die letzte Zeile selbst bestimmt? (Die Spalten A, B, E und F sind lückenlos gefüllt).
und das am Schluss folgendes passiert:
2. dass der Inhalt von Spalte D gelöscht wird.
3. das Duplikate entfernt werden, mit Spalten A und E als Kriterium
4. die Tabelle nach der Reihenfolge Spalte F absteigend, dann Spalte C aufsteigend sortiert wird.
ist das noch im Rahmen des machbaren?
LG
Jenny
AW: hatte vergessen zu speichern
13.08.2017 12:00:14
Christian
Hi,
hier noch eine Version, die die alle Treffer für eine Kombination nur beim ersten Vorkommen
auswirft.....
Option Explicit
Sub xFiles()
' Tabellenname > ggf. Anpassen
With ThisWorkbook.Worksheets("Tabelle1")
' Schalter für Wiederholungen (False/True)
Dim blnDublikate As Boolean
blnDublikate = False
' Datenbereich > ggf. anpassen!
Dim rng As Range
Set rng = .Range("A1:E16")
' Spalte ab der die ermittelten Wert eingetragen werden sollen (M)
Dim lTargetColum As Long
lTargetColum = 13
Dim lColumnKey1 As Long
Dim lColumnKey2 As Long
Dim lColumnValue As Long
' Spaltendefinitionen
lColumnKey1 = 1  '(A)
lColumnKey2 = 5  '(E)
lColumnValue = 4 '(D)
Dim ArrayList01 As New ArrayList
Set ArrayList01 = CreateObject("system.collections.arraylist")
Dim strKeyAE As String
Dim strValueD As String
' Zeile in der Range
Dim r As Variant
' Array für Key u. Value
Dim x(1) As String
' Alle Zeilen in a1 : E16 durchlaufen
For Each r In rng.Rows
' Wert aus jew. Zeile und Spalte D
strValueD = r.Cells(1, lColumnValue).Value
' Nur die Zeilen verarbeiten, in denen Spalte 4 (D) nicht leer ist
If Not strValueD = "" Then
' Schlüssel aus Spalte 1(A) und 5 (E) bilden
strKeyAE = r.Cells(1, lColumnKey1).Value & r.Cells(1, lColumnKey2)
' Schlüssel und Wert dem Array x zuweisen
x(0) = strKeyAE
x(1) = strValueD
' Array einer ArrayList ArrayList01 zuweisen
ArrayList01.Add x
End If
Next r
' Spaltenfortschritt
Dim c As Long
' Item d. ArrayListObjects
Dim j As Variant
' Werte bei jedem Key ausgeben (mit Dublikaten)
If blnDublikate = True Then
' Range nochmal durchlaufen
For Each r In rng.Rows
c = 0
strKeyAE = r.Cells(1, lColumnKey1).Value & r.Cells(1, lColumnKey2)
For Each j In ArrayList01
If strKeyAE = j(0) Then
r.Cells(1, lTargetColum + c).Value = j(1)
'r.Cells(1, lTargetColum + c).Interior.Color = rgbYellow
c = c + 1
End If
Next j
Next r
' Werte nur beim ersten Vorkommen ausgeben (ohne Dublikate)
' blnDublikate = False
Else
' ArrayList zum Merken der Verarbeiteten Schlüssel
Dim ArrayListOc As New ArrayList
Set ArrayListOc = CreateObject("system.collections.arraylist")
For Each r In rng.Rows
c = 0
strKeyAE = r.Cells(1, lColumnKey1).Value & r.Cells(1, lColumnKey2)
' Abgearbeiteten Schlüssel merken
With ArrayListOc
If Not .Contains(strKeyAE) Then
.Add strKeyAE
For Each j In ArrayList01
If strKeyAE = j(0) Then
r.Cells(1, lTargetColum + c).Value = j(1)
'r.Cells(1, lTargetColum + c).Interior.Color = rgbViolet
c = c + 1
End If
Next j
End If
End With
Next r
End If
End With
End Sub
VG, Ch.
AW: hatte vergessen zu speichern
13.08.2017 12:29:21
Christian
Hi,
zur Fehlermeldung:
folgenden Code ändern:
alt:
As New ArrayList

neu:
As Object 
kommt in der lezten Version des Prgr. 2 mal vor!
zu deinem Punkt 1 - Erkennung der lezten Zeile:
folgenden Code ändern:
        ' Datenbereich > ggf. anpassen!
Dim rng As Range
'Set rng = .Range("A1:E16")
Set rng = .Range("A1").CurrentRegion.Resize(, 6)
Die anderen Features die du dir wünschst,sind auch alle machbar.Bevor jemand das angeht, sollte das bisher Erstellte aber korrekt funktionieren! Btw. cool wäre es auch wenn du mal kurz erläuterst, wozu bzw. für was das ganze gut ist ...
VG, Christian
AW: hatte vergessen zu speichern
13.08.2017 12:50:24
Jenny
Hallo Christian,
der erste Vorschlag inkl. der beiden Änderungen schreibt leider die Texte in die falsche Zeile.
In Tabelle "vorher" das Ergebnis deines ersten Makros
In Tabelle "nachher" wie es eigentlich aussehen soll, also auch nachdem Duplikate entfernt wurden und Spalte D geleert wurde.
Das C das am Anfang noch in Zelle D5 steht, soll nicht wie es dein Makro macht nach M5 geschrieben werden, sondern nach T1. Da die Texte in C1 und E1 das erste mal in Zeile 1 stehen.
Das zweite Makro werde ich dann jetzt testen.
Gruß
Jenny
https://www.herber.de/bbs/user/115431.xlsm
AW: hatte vergessen zu speichern
13.08.2017 12:54:43
Jenny
Das Makro hier schreibt die Texte von D5:D17 ja nirgendwo hin.
wie gesagt D5 soll nach T1
D6 nach U1
D7 nach V1
usw., immer ans Ende der Zeile, in der die Kombination aus den Texten in A und E zum ersten mal auftritt.
Gruß
Jenny
AW: hatte vergessen zu speichern
13.08.2017 13:32:48
Christian
Hi,
"Das Makro hier schreibt die Texte von D5:D17 ja nirgendwo hin."
Doch, tut es! Passe die Parameter richtig an (Tabellenname), Startposition des Datenbereichs (Annahme von mir gem. deiner Testdaten "A1").
Damit du siehst was das Makro geschrieben hat, kannst du mal die Zeile
r.Cells(1, lTargetColum + c).Interior.Color = rgbViolet

aktivieren. Dann werden die Zellen eigefärbt.
Wenn ich dich richtig verstehe, muss die nächst freie Spalte, in die geschrieben werden soll, stets variabel ermittelt werden, da in den Spalten > "M" auch schon vor der Ausfürhung des Makros etwas stehen kann? Richtig?
Akt. würden diese Daten jetz überschrieben, da das Makro in bei jeder Trefferzeile in Spalte 'M' beginnt die Werte einzutragen.
VG, Christian
AW: hatte vergessen zu speichern
13.08.2017 13:46:03
Jenny
Hallo Christian,
dann haben wir das Problem, die Daten sollen nicht überschrieben, sondern ans Ende angefügt werden.
Das stimmt, je nach Zeile können die bereits vorhandenen Texte sogar bis Spalte OR gehen.
Jedenfalls was als Faustregel gilt:
In den Zeilen ohne Inhalt in Spalte D gibt es immer einen Inhalt in den Spalten M ff.
In den Zeilen mit Inhalt in Spalte D sind die Spalten M ff. immer leer.
Also hast du recht, das muss in jeder Zeile einzeln ermittelt werden, wieviel bereits in den Spalten M ff. steht.
Gruß
Jenny
AW: hatte vergessen zu speichern
13.08.2017 13:52:02
Christian
Hallo Jenny,
ok. das habe ich jetzt verstanden. War mir vorher nicht klar.
Ich passe dann das Makro entsprechend nochmal an, damit die gefunden Werte ausgehend von M ff.
in die nächste freie Spalte geschrieben werden!
Bin jetz aber erstmal raus.
VG, Christian
AW: hatte vergessen zu speichern
13.08.2017 13:53:37
Jenny
Hallo Christian,
nochmal vielen Dank für deine Mühe.
Wenn du genau sehen willst was ich meine, schau dir mal nochmal meine allerste Bsp Datei an,
da habe ich farblich unterschieden, was vorher da war und was neu sein soll wenn es fertig ist.
Gruß
Jenny
AW: hatte vergessen zu speichern
13.08.2017 20:16:41
Christian
Hallo Jenny,
wie versprochen habe ich das Makro nochmal so geändert, dass die Treffer immer am Ende der Zeile
mit dem ersten Vorkommen hinten angehängt werden....
Mit Bezug auf den Kollegen. Ich habe sicher auch schon > 5 h in der Aufgabenstellung versenkt...
Option Explicit
Sub xFiles()
' Tabellenname > ggf. Anpassen
With ThisWorkbook.Worksheets("Tabelle1")
' Schalter für Wiederholungen (False/True)
Dim blnDublikate As Boolean
blnDublikate = False
' Datenbereich > ggf. anpassen!
Dim rng As Range
'Set rng = .Range("A1:E16")
Set rng = .Range("A1").CurrentRegion.Resize(, 6)
' Spalte ab der die ermittelten Wert eingetragen werden sollen (M)
Dim lTargetColum As Long
lTargetColum = 13
Dim lColumnKey1 As Long
Dim lColumnKey2 As Long
Dim lColumnValue As Long
' Spaltendefinitionen
lColumnKey1 = 1  '(A)
lColumnKey2 = 5  '(E)
lColumnValue = 4 '(D)
Dim ArrayList01 As Object  'New ArrayList
Set ArrayList01 = CreateObject("system.collections.arraylist")
Dim strKeyAE As String
Dim strValueD As String
' Zeile in der Range
Dim r As Variant
' Array für Key u. Value
Dim x(1) As String
' Alle Zeilen in a1 : E16 durchlaufen
For Each r In rng.Rows
' Wert aus jew. Zeile und Spalte D
strValueD = r.Cells(1, lColumnValue).Value
' Nur die Zeilen verarbeiten, in denen Spalte 4 (D) nicht leer ist
If Not strValueD = "" Then
' Schlüssel aus Spalte 1(A) und 5 (E) bilden
strKeyAE = r.Cells(1, lColumnKey1).Value & r.Cells(1, lColumnKey2)
' Schlüssel und Wert dem Array x zuweisen
x(0) = strKeyAE
x(1) = strValueD
' Array einer ArrayList ArrayList01 zuweisen
ArrayList01.Add x
End If
Next r
' Spaltenfortschritt
Dim c As Long
' Item d. ArrayListObjects
Dim j As Variant
' Werte bei jedem Key ausgeben (mit Dublikaten)
If blnDublikate = True Then
' Range nochmal durchlaufen
For Each r In rng.Rows
c = 0
strKeyAE = r.Cells(1, lColumnKey1).Value & r.Cells(1, lColumnKey2)
For Each j In ArrayList01
If strKeyAE = j(0) Then
With r.Cells(1, lTargetColum)
If Not .Value = "" Then
' Abbruch wenn die letzte Zelle nich leer ist
If r.Cells(1, 16384)  "" Then
MsgBox "Zelle " & r.Cells(1, 16384).Address & " ist nicht  _
leer." & vbCrLf & _
"Die Verarbeitung wird abgebrochen", vbCritical + vbOKOnly, " _
Routine x-Files"
End
End If
With r.Cells(1, 16384).End(xlToLeft).Offset(0, 1)
.Value = j(1)
'.Interior.Color = rgbLime
End With
Else
With r.Cells(1, lTargetColum + c)
.Value = j(1)
'.Interior.Color = rgbLightGreen
End With
c = c + 1
End If
End With
End If
Next j
Next r
' Werte nur beim ersten Vorkommen ausgeben (ohne Dublikate)
' blnDublikate = False
Else
' ArrayList zum Merken der Verarbeiteten Schlüssel
Dim ArrayListOc As Object 'New ArrayList
Set ArrayListOc = CreateObject("system.collections.arraylist")
For Each r In rng.Rows
c = 0
strKeyAE = r.Cells(1, lColumnKey1).Value & r.Cells(1, lColumnKey2)
' Abgearbeiteten Schlüssel merken
With ArrayListOc
If Not .Contains(strKeyAE) Then
.Add strKeyAE
For Each j In ArrayList01
If strKeyAE = j(0) Then
With r.Cells(1, lTargetColum)
If Not .Value = "" Then
' Abbruch wenn die letzte Zelle nich leer ist
If r.Cells(1, 16384)  "" Then
MsgBox "Zelle " & r.Cells(1, 16384).Address & " ist  _
nicht leer." & vbCrLf & _
"Die Verarbeitung wird abgebrochen", vbCritical +  _
vbOKOnly, "Abbruch in Routine x-Files"
End
End If
With r.Cells(1, 16384).End(xlToLeft).Offset(0, 1)
.Value = j(1)
'.Interior.Color = rgbLime
End With
Else
With r.Cells(1, lTargetColum + c)
.Value = j(1)
'.Interior.Color = rgbLightGreen
End With
c = c + 1
End If
End With
End If
Next j
End If
End With
Next r
End If
End With
End Sub
Achtung: Nach dem Kopieren in ein Modul, noch die von der Forumssoftware eingefügten Umbrüche
wieder entfernen !
VG, Christian
AW: hatte vergessen zu speichern
13.08.2017 20:40:24
Jenny
Hallo Christian,
oh oh, auch 5 Stunden, ich bin euch beiden echt was schuldig.
Werde dann mal testen.
Gruß
Jenny
AW: hatte vergessen zu speichern
13.08.2017 20:46:39
Jenny
Sorry aber ich bekomme es nicht hin, wenn ich die _ lösche bleibt der Teil mit der Msg Box immer noch rot mit dem Fehler: Fehler beim Kompilieren. Erwartet: Bezeichner oder geklammerter Ausdruck.
AW: hatte vergessen zu speichern
13.08.2017 20:52:36
Jenny
Habe jetzt noch den Tabellennamen geändert, dadurch neue Fehlermeldung
Fehler beim Kompilieren. Erwartet: Zeilennummer oder Sprungmarke oder Anweisung oder Anweisungsende.
https://www.herber.de/bbs/user/115438.txt
Das ist das derzeitige Makro bei mir.
Jenny
habe es hinbekommen...
13.08.2017 21:02:03
Jenny
in meiner Testdatei funktioniert es.
Sehr gute idee Duplikate in den Spalten M ff. auszulassen, da hast du mir weitere mühsame Arbeit erspart.
Jetzt kommt noch der Test an der Originaltabelle.
Gruß
Jenny
auch der Test an der Originaltabelle hat geklappt
13.08.2017 21:09:49
Jenny
aber ich traue mich kaum zu fragen bei der Zeit die du bereits investiert hast,
was aus meiner Bitte geworden ist,
das zum Abschluss die Spalte D geleert wird,
die Duplikate in A und E entfernt werden
das Sortieren hab ich mich doch entschieden von Hand zu machen. (weil da ein Zwischenschritt notwendig ist, der sicher nochmal 1-2 Stunden Arbeit benötigt)
Gruß
Jenny
AW: auch der Test an der Originaltabelle hat geklappt
14.08.2017 17:24:07
Christian
Hi,
Spalte D leeren:
die folgende Zeile vor das allerletzte End With schreiben:
.Cells(1, lColumnValue .EntireColumn.ClearContents
sollte dann da unten so aussehen:

End If
' Inhalt in Spalte 4 (D) löschen
.Cells(1, lColumnValue .EntireColumn.ClearContents
End With
End Sub
Mit den Duplikaten entfernen. Musst du nochmal genauer erläutern!
Duplikate aus der Kombination A u. E. Oder A u. E getrennt?
Welcher Bereich soll von der Duplikateentfernen Routine erfasst werden? Nur der Bereich von A:E?
Dies würde ja z.B. zu Verschiebungen in der Zeilenstruktur führen. Vielleicht magst du das Duplikate Entfernen mal mit dem Makrorekorder aufzeichnen. und das Ergebnis hier posten.
VG, Christian
AW: auch der Test an der Originaltabelle hat geklappt
14.08.2017 21:23:21
Jenny
Hallo Christian,
die Zeile wird beim Einfügen rot... Syntaxfehler.
Mit dem Dup Entf. ist gemeint, wie wenn ich den kompletten gefüllten Bereich markiere, die normale Excel Funktion nutze und da die Spalten A und E einen Haken setze.
hier das aufgezeichnete Makro, wobei die Ranges bei zukünftigem Ausführen jedesmal andere sein werden.
Sub Makro1()
' Makro1 Makro
Range("A1:II15282").Select
Range("D15213").Activate
ActiveSheet.Range("$A$1:$II$15282").RemoveDuplicates Columns:=Array(1, 5), _
Header:=xlNo
End Sub
Aber ich habe mich doch entschieden, dich entscheiden zu lassen, wieviel Arbeit das ist, das mit dem Sortieren umzusetzen.
Was ich mache, bevor ich sortiere. Ich markiere den Bereich von E2 bis zum Ende der Daten in Spalte E, drücke dann Strg+C und Strg+V
Das hat dann zur Folge dass unten stehendes Makro ausgeführt wird.
Dann sortiere ich nach Spalte F absteigend, dann Spalte C aufsteigend.
Im Anschluss daran markiere ich nochmal Bereich von E2 bis zum Ende der Daten in Spale E, drücke dann Strg+C und Strg+V und lasse das Makro nochmal durchlaufen.
Wenn du jetzt fragst warum 2mal, das erste mal ist dafür da, dass überhaupt alle notwendigen Daten in den Spalten C und F stehen, damit nach diesen Spalten sortiert werden kann. Das zweite mal, damit die Formeln richtig berechnet werden, die von der Sortierreihenfolge abhängen.
Das Makro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TC As Long
Dim c As Range
Application.ScreenUpdating = False
If Target.Columns.Count > 1 Then Exit Sub
If Target.Column = 5 Or Target.Column = 7 Then TC = Target.Column Else Exit Sub
'If Target.Count = 1 And Target  "" Then
On Error GoTo ERREXIT
Application.EnableEvents = False
Select Case TC
Case 5: For Each c In Target
If c  "" Then Call SpalteE(c)
Next
Case 7: For Each c In Target
If c  "" Then
Call SpalteG(c)
Call SpalteE(c)
End If
Next
End Select
ERREXIT:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub SpalteG(ByVal Target As Range)
Dim r As Range, c As Range, z&, cc As Range, zf&
Dim gefunden As Boolean
If Target.Offset(, -6)  "" Then
z = Target.Row
gefunden = False
Set cc = Range("A1:A" & z - 1).Find(Target.Offset(, -6).Value, _
Range("A1"), xlValues, xlWhole)
If Not cc Is Nothing Then
zf = cc.Row
Do
Set cc = Range("A1:A" & z - 1).FindNext(cc)
If cc.Offset(, 6) = Target Then
Target.Offset(, -2) = cc.Offset(, 4) '& " " & (cc.Offset(, 4).Address)
gefunden = True
End If
Loop Until cc Is Nothing Or cc.Row = zf Or gefunden
End If
If Not gefunden Then Target.Offset(, -2).Value = "n.v."
End If
End Sub
Sub SpalteE(ByVal Target As Range)
Dim lngR As Long
lngR = Target.Row
Cells(lngR, 2).FormulaR1C1 = Cells(1, 2).FormulaR1C1
Cells(lngR, 3).FormulaR1C1 = Cells(1, 3).FormulaR1C1
Cells(lngR, 6).FormulaR1C1 = Cells(1, 6).FormulaR1C1
Cells(lngR, 8).FormulaR1C1 = Cells(1, 8).FormulaR1C1
Cells(lngR, 9).FormulaR1C1 = Cells(1, 9).FormulaR1C1
Cells(lngR, 10).FormulaR1C1 = Cells(1, 10).FormulaR1C1
Cells(lngR, 11).FormulaR1C1 = Cells(1, 11).FormulaR1C1
Cells(lngR, 12).FormulaR1C1 = Cells(1, 12).FormulaR1C1
Rows(lngR).Copy
Cells(lngR, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Target.Select
End Sub

AW: auch der Test an der Originaltabelle hat geklappt
14.08.2017 22:30:15
Jenny
Hallo Christian,
die Zeile wird beim Einfügen rot... Syntaxfehler.
Mit dem Dup Entf. ist gemeint, wie wenn ich den kompletten gefüllten Bereich markiere, die normale Excel Funktion nutze und da die Spalten A und E einen Haken setze.
hier das aufgezeichnete Makro, wobei die Ranges bei zukünftigem Ausführen jedesmal andere sein werden.
Sub Makro1()
' Makro1 Makro
Range("A1:II15282").Select
Range("D15213").Activate
ActiveSheet.Range("$A$1:$II$15282").RemoveDuplicates Columns:=Array(1, 5), _
Header:=xlNo
End Sub
Aber ich habe mich doch entschieden, dich entscheiden zu lassen, wieviel Arbeit das ist, das mit dem Sortieren umzusetzen.
Was ich mache, bevor ich sortiere. Ich markiere den Bereich von E2 bis zum Ende der Daten in Spalte E, drücke dann Strg+C und Strg+V
Das hat dann zur Folge dass unten stehendes Makro ausgeführt wird.
Dann sortiere ich nach Spalte F absteigend, dann Spalte C aufsteigend.
Im Anschluss daran markiere ich nochmal Bereich von E2 bis zum Ende der Daten in Spale E, drücke dann Strg+C und Strg+V und lasse das Makro nochmal durchlaufen.
Wenn du jetzt fragst warum 2mal, das erste mal ist dafür da, dass überhaupt alle notwendigen Daten in den Spalten C und F stehen, damit nach diesen Spalten sortiert werden kann. Das zweite mal, damit die Formeln richtig berechnet werden, die von der Sortierreihenfolge abhängen.
Das Makro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TC As Long
Dim c As Range
Application.ScreenUpdating = False
If Target.Columns.Count > 1 Then Exit Sub
If Target.Column = 5 Or Target.Column = 7 Then TC = Target.Column Else Exit Sub
'If Target.Count = 1 And Target  "" Then
On Error GoTo ERREXIT
Application.EnableEvents = False
Select Case TC
Case 5: For Each c In Target
If c  "" Then Call SpalteE(c)
Next
Case 7: For Each c In Target
If c  "" Then
Call SpalteG(c)
Call SpalteE(c)
End If
Next
End Select
ERREXIT:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub SpalteG(ByVal Target As Range)
Dim r As Range, c As Range, z&, cc As Range, zf&
Dim gefunden As Boolean
If Target.Offset(, -6)  "" Then
z = Target.Row
gefunden = False
Set cc = Range("A1:A" & z - 1).Find(Target.Offset(, -6).Value, _
Range("A1"), xlValues, xlWhole)
If Not cc Is Nothing Then
zf = cc.Row
Do
Set cc = Range("A1:A" & z - 1).FindNext(cc)
If cc.Offset(, 6) = Target Then
Target.Offset(, -2) = cc.Offset(, 4) '& " " & (cc.Offset(, 4).Address)
gefunden = True
End If
Loop Until cc Is Nothing Or cc.Row = zf Or gefunden
End If
If Not gefunden Then Target.Offset(, -2).Value = "n.v."
End If
End Sub
Sub SpalteE(ByVal Target As Range)
Dim lngR As Long
lngR = Target.Row
Cells(lngR, 2).FormulaR1C1 = Cells(1, 2).FormulaR1C1
Cells(lngR, 3).FormulaR1C1 = Cells(1, 3).FormulaR1C1
Cells(lngR, 6).FormulaR1C1 = Cells(1, 6).FormulaR1C1
Cells(lngR, 8).FormulaR1C1 = Cells(1, 8).FormulaR1C1
Cells(lngR, 9).FormulaR1C1 = Cells(1, 9).FormulaR1C1
Cells(lngR, 10).FormulaR1C1 = Cells(1, 10).FormulaR1C1
Cells(lngR, 11).FormulaR1C1 = Cells(1, 11).FormulaR1C1
Cells(lngR, 12).FormulaR1C1 = Cells(1, 12).FormulaR1C1
Rows(lngR).Copy
Cells(lngR, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Target.Select
End Sub

AW: auch der Test an der Originaltabelle hat geklappt
14.08.2017 22:43:39
Christian
ups, da fehlte eine Klammer
.Cells(1, lColumnValue).EntireColumn.ClearContents

Kannst du sagen bis zu welcher Spalte die Daten max. gehen?
Ansonnste muss man zuerst die Breite des Datenbereiches ermitteln, und da muss ich mich erstmal schlau machen,wie man dass am geschicktesten (effizentesten) anstellt...
Bei den Datenmengen die da bei dir anliegen, ist Performance ja schon ein Thema.
Btw. du solltes dringend anfangen VBA zu lernen... :-?
Gruß, Ch.
AW: auch der Test an der Originaltabelle hat geklappt
14.08.2017 23:05:49
Jenny
Hallo Christian,
VBA lernen, da sagst du was schönes, hatte im Studium 3 Semester Java. Ist aber auch schon 8 Jahre her und war nicht grad mein Lieblingsfach. Es hatte nicht an der Theorie gehapert, sondern daran, zu erkennen, was jetzt für die jeweilige Problemstellung das passende ist von dem was ich da in der Theorie gelernt hab.
Abgesehen davon dass es so klappt, hatte ich eigentlich auch Dinge ausprobiert, wie noch Klammern zu setzen, sie zu löschen oder auch die zweite 1 zu löschen falls die zu viel gewesen wäre.
Zu den Dimensionen, wenn man es auf lange Sicht sieht, leg es mal auf 600 Spalten also Spalte XB wenn ich mich nicht vertan hab aus. Da ist ja sicherlich nur eine Zahl im Makro oder eine Range zu ändern, wenn doch mal mehr von Nöten sein sollen.
Zur Performance, das Makro wird ja nicht alle 2 Minuten ausgeführt, da ist Performance nicht ganz so tragisch. Zum Vergleich das Sub Spalte E für die ganze Tabelle ausführen dauert ca. 7 Minuten.
Die eigentliche Performance der Tabelle ist sehr gut, denn sie ist reiner Text. Alle Blätter zusammen haben 615.400 Zellen mit Inhalt.
Aber du wunderst dich jetzt, 8 Zellen mit Formeln, mehr nicht. (nämlich die 8 wo das Sub Spalte E die Formeln herholt).
Alle notwendigen Berechnungen übernimmt das zuletzt genannte Makro, eben aus dem Grund dass nicht jedesmal alles neu berechnet wird, sondern das Makro beschränkt es auf die Zeilen die sich geändert haben. Damit ist die Tabelle immer aktuell und die Rechenzeit minimiert.
Gruß
Jenny
AW: auch der Test an der Originaltabelle hat geklappt
14.08.2017 23:22:31
Christian
... gut, die Duplikate aus A und E entfernen und den Bereich bis XD erfasssen kriegen wir auch noch hin.
Vielleicht lässt sich der Bereich ja auch clever dynamisch erfassen, z.b. durch das Makro was ich dir geschrieben habe. Dieses Makro schreibt ja fortlaufend in die Spalte M ff.. Hier könnte man z.B. ansetzen und sich immer die letzte Spaltennummer merken, und auf größer zur jeweils akt. prüfen, und hätte so nach der Ausführung die max. Spaltennummer ermittelt.
Ich schaus mir morgen mal im Detail an.
Grüße, Ch.
AW: auch der Test an der Originaltabelle hat geklappt
14.08.2017 23:26:33
Jenny
Hallo Christian,
vielleicht sage ich das ja auch aus Unwissen, aber was ist wenn in die vor dem ausführen des Makros längste Zeile nichts geschrieben wird während des Ausführens?
Das Makro schaut doch nur in den Zeilen nach der Länge, in denen es die erste Übereinstimmung in A und E gibt oder?
Gruß
Jenny
Versetzen von Texten
13.08.2017 13:07:00
Texten
Hallo Jenny,
ich habe ebenfalls eine Lösung erarbeitet. Hier meine Datei
https://www.herber.de/bbs/user/115432.xlsm
Ich habe Deine Tabelle um einige Zeilen oben und zwei Spalten links erweitert. Die ursprünglichen Daten müssen (nur am Anfang) mit einer "1" in der Spalte A (Steuerg.1) versehen werden. Die Spalte B (Steuerg.2) ist zur Richtigstellung von Mehrfachnennungen erforderlich. Die Zeilen 22 bis 28 habe ich zu Deinen Vorgaben zu Testzwecken hinzugefügt. Bitte zuerst den Button "Texte kopieren" betätigen und dann abwarten, bis unter "G3" ein Hinweistext erscheint. Dann kannst Du mit dem 2. Button die überflüssigen Zeilen löschen. Neue zu verarbeitende Sätze können dann einfach hinzugefügt werden.
Bitte mal ausprobieren, Rückmeldung wäre schön.
Mit freundlichem Gruß
Peter Kloßek
AW: Versetzen von Texten
13.08.2017 13:33:40
Texten
Hallo Peter,
vom Ergebnis her ist das das was ich wollte. (mit einer kleinen Ausnahme das was jetzt bei dir in den Spalten Nff. steht, soll eine Spalte nach links also in M ff.)
Bzw. auch beim Start stehen die Daten in der Originaltabelle schon in M die bei dir beim Start in N standen.
Nur die Originaltabelle hat mehr als 15000 Zeilen und mehr als 400 Spalten.
Hat also ganz andere Außmaße
Ich weiß nicht wo ich deine Hilfsspalten und Hilfszeilen hintun soll. Wenn ich da Spalten hinzufüge muss ich anfangen, alle Spaltenbezüge in allen anderen Makros zu ändern, damit diese Makros weiterhin funktionieren.
Gruß
Jenny
AW: Versetzen von Texten
13.08.2017 18:06:13
Texten
Hallo Jenny,
schönen Dank für Deine weiteren Hinweise. Ich habe mein Programm überarbeitet. Es können nunmehr bis zu 600 Spalten und 20.000 Zeilen verwendet werden. Die zusätzlichen Zeilen und Spalten in meinem Programm sind absolut notwendig. Ich wüsste nicht, wie sonst diese komplizierte Logik bearbeitet werden könnte.
Das ist jedoch kein Problem. Du kopierst einfach den originalen Blattinhalt nach "C6". Zuvor evtl. vorhandene Datensätze im Programm radieren. Dann lässt Du das Programm laufen. Solange in "G3" warten!! steht, keine weiteren Befehle auslösen. Danach kannst Du mit dem 2. Button die nicht erforderlichen Zeilen radieren und anschließend die Daten in die Tabelle2 übertragen. Man kann aber auch ohne Löschungen die Daten nach Tabelle2 übertragen. In der Tabelle2 stehen dann die aufbereiteten Daten genau so, wie Du es wünscht. Sofern in der Originaldatei in den freien Spalten B und C bzw. F bis L Daten - auch Formeln - vorhanden waren, bleiben diese erhalten, sofern sie in die Programmdatei mit übertragen wurden. Hier die berichtigte Datei:
https://www.herber.de/bbs/user/115437.xlsm
Probleme gelöst - oder noch weitere Wünsche? Bitte weitere Rückmeldung.
Mit freundlichem Gruß
Peter Kloßek
AW: Versetzen von Texten
13.08.2017 18:19:04
Texten
Hallo Peter,
ja was dann im Endeffekt in Tabelle2 steht, ist das was ich gesucht habe.
Aber ist diese Logik wirklich so kompliziert?
Ich mache doch nichts weiter, als in der Tabelle Duplikate in den Spalten A und E zu entfernen. Da ich nicht will, dass die Texte, die in den Zeilen die entfernt werden in Spalte D stehen, verloren gehen, schreibe ich sie in die Zeile, die nach dem Duplikate entfernen übrig bleibt.
Das ist die Logik die da hintendran steckt.
Gruß
Jenny
AW: Versetzen von Texten
13.08.2017 19:25:51
Texten
Hallo Jenny,
schönen Dank für Deine Antwort. Die menschliche Logik hält sich bei dem Problem zwar in Grenzen, aber die Umsetzung in einem Programm ist x-mal komplizierter. Weil Excel und VBA eine ganz spezielle Logik erfordern. Mich hat dieses Thema gereizt und es freut mich, wenn Du (zunächst einmal) zufrieden bist. Mein Arbeitsaufwand alles in Allem betrug ca. 15 Std. Bitte noch mal ausgiebig testen und bei auftretenden Störungen wieder melden.
Bei einem größeren Datenvolumen könnte es sein, dass Excel/VBA mit den von mir eingesetzten Pausen nicht mithalten kann und dann leider falsche Ergebnisse liefert. Es handelt sich hierbei um solche Anweisungen:
Application.OnTime Now + TimeValue("00:00:02"), "Makro5"
Application.OnTime Now + TimeValue("00:00:15"), "Makro3"
Application.Wait (Now + TimeValue("0:00:02"))
Möglicherweise musst Du die Pausen (in Sekunden) heraufsetzen.
Mit freundlichem Gruß
Peter Kloßek
AW: Versetzen von Texten
13.08.2017 19:35:51
Texten
15 Stunden!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
das hätte ich nicht für möglich gehalten. Ich kann mich nur für diese Mühe bedanken.
Am Anfang dachte ich es ist lediglich eine kleine Änderung an der UDF von Nöten damit sie mehr Zeichen verkraftet.
Ich mache das ganze aus folgendem Grund, die Tabelle hat wie du gemerkt hast auch so schon riesiege Ausmaße. Im jetzigen Zustand sind es 188854 Zellen mit Inhalt.
Ohne diese Schritte wären es ca. 200.000 mehr. Also auch noch mehr Formeln zum Berechnen mit entsprechender Rechenzeit. Und auch so habe ich alle Daten die ich brauche. Diese 200.000 zusätzliche Zellen wären nur Wiederholungen vorangegangener Zeilen.
Nazürlich geht es in Realität um andere Inhalte als in der Bsp. Datei.
Viele Grüße
Jenny
AW: UDF stößt an ihre Grenze (Alternative?)
15.08.2017 20:10:23
Christian
Hi,
hier das komplette 'Programm' mit Spalte D löschen und Entfernen der Duplikate...
Bitte komplett in ein neues Modul kopieren. Es braucht nur die Sub 'AddEndOfRow_WoDup' aufgerufen zu werden. Die Private Routinen sind alles nur Subroutinen die im Programmverlauf aufgerufen werden.
Das mit dem Sortieren habe ich nicht verstanden.
VG, Ch.
https://www.herber.de/bbs/user/115499.txt
AW: UDF stößt an ihre Grenze (Alternative?)
15.08.2017 20:51:20
Jenny
Hallo Christian,
naja das mit dem Sub Spalte E ist so gemeint, dass sobald es eine Änderung an Spalte E gibt, das Makro die Formeln aus Zeile 1 in alle Zeilen mit Änderungen kopiert und Werte einfügt.
Mit anderen Worten ich kann das komplette Blatt aktualisieren, indem ich jede genutzte Zelle in Spalte E außer E1 kopiere und wieder einfüge.
Ich habe 2 Blätter mit Verbindungen aus dem Internet, die ich regelmäßig von Hand aktualisiere, damit ändern sich die Ergebnisse der Formeln, die sich auf diese beiden Blätter beziehen. (Spalten B, C und F)
Daher dann das erste Sortieren, damit die Tabelle nach den aktuellen Werten aus dem Internet sortiert wird.
Dann nochmal das Sub Spalte E, damit die Formel, die von der Reihenfolge der Datensätze abhängt, mit den aktuellen Daten berechnet wird (Spalte L).
Das Makro funktioniert.
Gruß
Jenny
AW: UDF stößt an ihre Grenze (Alternative?)
15.08.2017 21:14:11
Christian
... 'das Makro funktioniert' na immerhin etwas. Ein bisschen mehr Begeisterung darf es schon sein ;-)
Du hattest mal geschrieben " 4. die Tabelle nach der Reihenfolge Spalte F absteigend, dann Spalte C aufsteigend sortiert wird."
Bezieht sich "Tabelle" auf die gleiche Range, mit der auch die Duplikate entfernen Funktionalität arbeitet?
Gruß, Ch.
AW: UDF stößt an ihre Grenze (Alternative?)
18.08.2017 12:56:22
Jenny
Hallo Christian,
irgendwie war die Mail untergegangen dass du geantwortet hast. Sorry
Natürlich freue ich mich über das funktionierende Makro.
Und mit der Range jein, die Duplikate sollen ja zuerst entfernt werden.
Also soll sich das Sortieren auf die Zeilen beziehen, die nach dem Duplikate entfernen noch übrig bleiben. Jedoch die Spalten bleiben dieselben.
Allerdings macht das Sortieren wenig sinn, solange in C und F noch Zellen mit #NV stehen. Dafür ist ja das Sub SpalteE da, damit #NV durch die richtigen Werte ersetzt werden.
Gruß
Jenny
AW: UDF stößt an ihre Grenze (Alternative?)
19.08.2017 22:46:06
Christian
Hallo Jenny,
meine Frage bezgl. der Range für das Sortieren, zielte darauf ab,
ob man die gleiche Methodik für die Bestimmung der zu sortierenden Range
anwendenden kann wie bei der Entfernung der Duplikate. Wenn mann die Datenstruktur kennt,
vermutl. ein dumme Frage.
Um die Sache Rund zu machen würde es vermutl. auch Sinn machen, die verschiedenen Makros (incl. SpalteE) und eine mögliche SortRoutine, nacheinander aus einer Hauptroutine aufrufen zu lassen und mal zu Prüfen, wie du dir diese Copy Paste Aktion sparen könntest.
Viele Grüße,
Christian
AW: UDF stößt an ihre Grenze (Alternative?)
20.08.2017 09:32:31
Jenny
Hallo Christian,
ich weiß gar nicht ob ich sie mir sparen will. Ich nutze das Sub Spalte E in zweierlei Hinsicht
1. die permanente aktualisierung der Tabelle, indem ich in Spalte E oder G etwas einfüge und dann das entsprechende Makro gestartet wird, mit dem Ziel, das wenn ich einen neuen Datensatz einfüge, in dieser Zeile die Formeln aus Zeile 1 berechnet werden.
2. Wenn es ein Update bei den Daten gibt, deren Inhalte die aus dem Internet stammen, also das worüber wir die ganze Zeit schon reden. In dem Fall will ich nicht nur eine einzelne Zeile, sondern die ganze Tabelle aktualisieren.
Hierzu hat sich das Sub Spalte E halt auch angeboten, weil es wenn ich die ganze Spalte (außer Zeile 1) kopiere und einfüge, auch alles aktualisiert.
Aber das sind zeitlich 2 komplett getrennte Arbeitsschritte.
Die Möglichkeit dass das Sub Spalte E durch einen Worksheet Change ausglöst wird, muss unbedingt erhalten bleiben.
Wenn du für den 2. Fall es für sinnvoller erachtest, das Sub Spalte E anderweitig zu starten, kannst du das gerne tun.
Die Datenstruktur hat sich nicht geändert, also abgesehen von weniger Zeilen, kann die Range dann so beibehalten werden.
Gruß
Jenny

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige