Microsoft Excel

Herbers Excel/VBA-Archiv

Nur ungleichen Text in Zelle verketten.

Betrifft: Nur ungleichen Text in Zelle verketten. von: Andy
Geschrieben am: 03.09.2004 12:35:44

Hallo.

Ich habe da eine Sache zu erledigen.

Folgede Daten liegen vor.

Es handelt sich um ca. 38 000 Datensätze, deshalb brauch ich eine automatisierte Lösung.

Spalte A ist eine Zahl Spalte B ist ein Text.

Bsp:

SpalteA SaplteB

1000 Material Sand blau 1 kg
1000 Material Sand rot 1 kg
1000 Material Sand gelb 1 kg
1000 Material Sand grün 1 kg
1001 Material Holz blau 2 m
1001 Material Holz grün 2 m
1001 Material Holz rot 2 m
1002 TextX gelb 23 mm
1002 TextX rot 23 mm
1002 TextX blau 23 mmm

Ich möchte nun z.B. in Spalte C NUR die unterschiede VERKETTET haben.

Also als Ergebnis dann in Spalte C am liebsten bei dem 1. Material mit neuer Zahl in Spalte A folgendes stehen haben. Wenn es bei dem letzten steht machts auch nix.

Spalte C
blau, rot, gelb, grün
blau, grün, rot
gelb, rot, blau

Die UNTERSCHIEDE sollen mit ", " getrennt VERKETTET werden und sobald sich die Nummer in Spalte A ändert sollen von neuem NUR die UNTERSCHIEDE des Textes in Spalte B in Spalte C verkettet werden.

Bin für jede Info dankbar.

Grüsse
Andy

  


Betrifft: AW: Nur ungleichen Text in Zelle verketten. von: Andy
Geschrieben am: 06.09.2004 10:02:25

Hallo.

Kann mir da denn wirklich keiner helfen?

Bitte es drängt etwas.

Vielen Dank
Andy


  


Betrifft: AW: Nur ungleichen Text in Zelle verketten. von: Andy
Geschrieben am: 06.09.2004 20:01:38

Bitte liebe Leute...

Nur ein Tipp.

Danke.


  


Betrifft: AW: Nur ungleichen Text in Zelle verketten. von: sicci
Geschrieben am: 06.09.2004 23:24:07

Hallo andy,

ein wegen evtll. Anpassungen nicht allzu eleganter Ansatz: versuche, mittels Daten/TextInSpalten - Trenng. bei Leerzeichen, die ungleichen Texte in eine Spalte zu bekommen. Bei Deinen Testwerten (mit Anpassung bei den 3 letzten) wären die Daten dann zB in A3:F12. In G3 die Formel: =WENN(ISTLEER(A4);D3;WENN(A3=A4;D3&", "&G4;D3)). In der bedingten Formatierung zB in A4 die Formel: =A4=A3 - Schriftfarbe=weiß.

Den einzig möglichen andern Weg seh ich über VBA. Für mich ein bißchen tüftelig.
Muß ich noch testen. Hast Du VBA-Kenntnisse?

Gruß sicci


  


Betrifft: AW: Nur ungleichen Text in Zelle verketten. von: Andy
Geschrieben am: 07.09.2004 09:51:56

Vielen Dank erst mal.

Aber das mit dem ungleichen Text in eine andere Spalte zu bekommen mit Hilfe von Trennung wenn Leerzeichen ist etwas zu arg. Es handelt sich um ca. 38 000 Datensätze. Hier mal zwei echte Beispiele solcher Texte.

Mel 07300 Eckver 3-4 F2 175x115x71 mm, Sylt gelb 2 mt=1 KT
Mel 07300 Eckver 3-4 F2 175x115x71 mm, Sylt gelb-orange 2 mt=1KT
Mel 07300 Eckver 3-4 F2 175x115x71 mm, Sylt orange 2 mt=1 KT

Hier sieht man, dass sich die Texte nur beim Farbton unterscheiden.

Ich hätte jetzt gerne in einer anderen Zelle folgendes:

gelb, gelb-orange, orange

VBA ... hmm damit hab ich noch nix gemacht. Also liebe VBA Experten, wenn da einer vielleicht eine "schnelle Lösung" hätte wäre ich super dankbar.

Wenn es nicht so vielen Datensätze wären, würde ich es ja per Hand machen.

Danke Euch vielmals.

mfg
Andy


  


Betrifft: AW: Nur ungleichen Text in Zelle verketten. von: sicci
Geschrieben am: 08.09.2004 01:57:08

Hallo Andy,
kam erst jetzt zum testen:

hier ein vba-Vorschlag, der einen Wortvergleich (mittels Ermittlung der Leerzeichen in der Zelle) vornimmt.
Deine 'Eigenschaften' werden extrahiert und durch Komma getrennt in die erste Zeile (SpalteC) der in Spalte A gleichwertigen Zellen geschrieben.
Der Aufbau muß dabei wie in Deiner Anfrage angegeben sein, und: es wird nur bis zum ersten ungleichen 'Wort' im Zelltext geprüft - was hinter diesem steht, wird nicht mehr geprüft.
Aber das scheint ja in Deinen Daten immer so zu sein.
Spalte A: Mat-Nr. Spalte B: Text

Mit Alt/F11 in VBA-Editor wechseln, im linken Fenster Projekt.. rechtsklicken, Einfügen/Modul (=allgemeines Modul). Im so erstellten rechten Modul-Fenster den Code eingeben/hineinkopieren.

Sub test2()
Dim intRC%, intZähler%, intleer%, intleer1%, intleer2%
Dim strWort$, strWort1$, strWort2$

intZähler = -1
For intRC = 1 To Cells(Rows.Count, 1).End(xlUp).Row
   If Cells(intRC, 1).Value = Cells(intRC + 1, 1).Value Then
      intleer1 = 1: intleer2 = 1: intleer = 1:
      intZähler = intZähler + 1: strWort1 = "": strWort2 = ""
            Do Until strWort1 <> strWort2
               intleer1 = InStr(intleer, Cells(intRC, 2).Value, " ", 1)
               intleer2 = InStr(intleer, Cells(intRC + 1, 2).Value, " ", 1)
               strWort1 = Mid(Cells(intRC, 2).Value, intleer, intleer1 - intleer)
               strWort2 = Mid(Cells(intRC + 1, 2).Value, intleer, intleer2 - intleer)
               intleer = intleer1 + 1
            Loop
         If strWort = "" Then
            strWort = strWort1 & ", " & strWort2
         Else: strWort = strWort & ", " & strWort2
         End If
      Cells(intRC - intZähler, 3).Value = strWort
   Else: strWort = "": intZähler = -1
   End If
Next

End Sub


Gutes Gelingen!
Gruß sicci


  


Betrifft: AW: Nur ungleichen Text in Zelle verketten. von: Andy.
Geschrieben am: 08.09.2004 19:36:05

Hi.

Ich werde es gleich morgen früh (Donnerstag) mal ausprobieren. War heute unterwegs und hatte noch nicht die Gelegenheit.

1000 Dank schon mal. Werde berichten, ob es gefunkt hat.

Grüsse
Andy


  


Betrifft: AW: Nur ungleichen Text in Zelle verketten. von: Andy
Geschrieben am: 09.09.2004 09:55:29

Hi.

Erst mal herzlichen Dank. Zu Hause mit Excel 2003 hat es mit ein paar Testwerten vorzüglich funktioniert. Echt spitze!

Im Bürö bekomme ich aber leider einen Laufzeitfehler mit dem Hinweis "Überlauf".

Wenn ich einzel die Codezeilen bestätige, hängt er sich in Deinem VBA_Modul an dieser Stelle:

For intRC = 1 To Cells(Rows.Count, 1).End(xlUp).Row

auf.

Im Büro benutze ich Excel 2000 SR-1.

Wie schon erwähnt habe ich ca. 38.000 Datensätze in der Exceldatei.

Also, wenn Du mir da noch helfen könntest, wärs ein Traum!

100000 Dank.

Grüsse
Andy


  


Betrifft: AW: Nur ungleichen Text in Zelle verketten. von: Andy.
Geschrieben am: 08.09.2004 19:36:06

Hi.

Ich werde es gleich morgen früh (Donnerstag) mal ausprobieren. War heute unterwegs und hatte noch nicht die Gelegenheit.

1000 Dank schon mal. Werde berichten, ob es gefunkt hat.

Grüsse
Andy