Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Excel
  Excel: Zeilen vergleichen und zusammenführen

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:   Excel: Zeilen vergleichen und zusammenführen (25619 mal gelesen)
shed777
Mitglied


Sehen Sie sich das Profil von shed777 an!   Senden Sie eine Private Message an shed777  Schreiben Sie einen Gästebucheintrag für shed777

Beiträge: 6
Registriert: 29.12.2006

erstellt am: 29. Dez. 2006 11:01    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo

Ich habe eine Excel Tabelle, mehrere zeilen mit mehreren spalten, wobei die 1. spalte die eindeutigen IDs beinhaltet, die allerdings doppelt vorkommen können:

A B C D E
ID Land Unterkunft Kommentar
1 österreich hotel gut
2 schweiz hotel gut
3 deutschland privat schlecht
3 deutschland privat in ordnung
4 italien privat ok
5 portugal hotel ok
6 england privat prima
6 england privat super

Ich möchte jetzt gerne alle zeilen durchgehen, vergleichen ob die nachfolgende zeile die selbe ID hat, falls ja, dann in diesen beiden zeilen die letzte spalte ("E") zusammenführen, sodass es dann beispielsweise nur mehr eine zeile mit der ID 6 gibt, die dann so aussieht:

6 england privat prima super

Vielleicht kann mir hierbei jemand weiterhelfen?! Vielen herzlichen Dank, markus

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

hkarn
Mitglied
Dipl.Ing.(BA) Holztechnik


Sehen Sie sich das Profil von hkarn an!   Senden Sie eine Private Message an hkarn  Schreiben Sie einen Gästebucheintrag für hkarn

Beiträge: 38
Registriert: 09.10.2003

Windows 7
Autosketch 9.0

erstellt am: 29. Dez. 2006 12:01    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

Hallo Markus,

sollte mit folgender Formel in Spalte E klappen:

=WENN(A3=A4;D4;"")

wenn aber die ID's öfter als zweimal vorhanden sind mußt du eben die Fomel auch in Spalte F,G etc. leicht abgewandelt einfügen:

F: =WENN(A3=A5;D5;"")

G: =WENN(A3=A6;D6;"")

Gruß & guten Rutsch

hk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8017
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 29. Dez. 2006 13:02    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

Ihr mit euren langweiligen Formeln 
is doch viel schöner, wenn's sich automatisch füllt 

Code:
Option Explicit
Public Sub Zusammenfuehren()
Dim i As Long, j As Long, k As Long
Dim Ar(8, 3) As String  ':)ole

'Bereich: Spalten A : D (i+1)
For i = 0 To 3
    'Bereich Zeilen: 2:9 (j+2)
    For j = 0 To 8
        'array füllen mit DatenTabelle
        Ar(j, i) = Tabelle1.Cells(j + 2, i + 1).Value
        If j > 0 Then
        'wenn ID übereinstimmt
        If Ar(j, 0) = Ar(j - 1, 0) Then
            'Spalte E bekommt neuen Eintrag:
            'Tabelle1.Cells(j + 2, 5) = Ar(j - 1, 3)
            If Tabelle1.Cells(j + 1, 5).Value = "" Then
                Tabelle1.Cells(j + 2, 5) = Ar(j - 1, 3)
            Else 'wenn schon einer da war, Spalte F
                Tabelle1.Cells(j + 2, 5) = Tabelle1.Cells(j + 1, 5)
                Tabelle1.Cells(j + 2, 6) = Ar(j - 1, 3)
            End If
            'Kenntlich machen der "überflüssigen" Zeilen
            Tabelle1.Cells(j + 1, 1).Interior.ColorIndex = 3
        End If
        End If
    Next j
Next i
'Wer 's mag, kann auch die überflüssigen Zeilen löschen:
'und wenn wir Zeilen löschen, tun wir das immer rückwärts!
'For k = 10 To 2 Step -1
'    If Tabelle1.Cells(k, 1).Interior.ColorIndex = 3 Then
'        Tabelle1.Cells(k, 1).EntireRow.Delete
'    End If
'Next k
End Sub


Anmerkungen: Array ist an Deine Daten angepaßt: Dim Ar(8, 3) As String
demzufolge auch die Schleifen. Wenn Dein Datenbereich also größer ist, wovon ich ausgehe, mußt Du natürlich diese Bereiche anpassen.
Ich gehe von einer Überschrift in Zeile 1 aus, Daten sind nach ID sortiert und mehr als 3 gleiche ID nacheinander kommen nicht vor.

[e] ich mag keine smilies im code und Zeilen müssen rückwärts gelöscht werden  [/e]
------------------
Gruß,
runkelruebe                        Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

[Diese Nachricht wurde von runkelruebe am 29. Dez. 2006 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

startrek
Moderator
Architekt


Sehen Sie sich das Profil von startrek an!   Senden Sie eine Private Message an startrek  Schreiben Sie einen Gästebucheintrag für startrek

Beiträge: 1361
Registriert: 13.02.2003

.

erstellt am: 29. Dez. 2006 23:34    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich


test_duplikate.xls.txt

 
Hallo,

bin ziemlich spät dran heute, hier auch mal noch ein Chaotencode zum Thema;-)

Code:

Sub test()
    Dim i&, x%, flag As Boolean, arr, arrIndex%
    With Sheets("Tabelle1")
        arr = Application.Transpose(Range(.Cells(1, 1), .Cells(2, 4)))
        x = 2
        For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
            flag = False
            For arrIndex = LBound(arr, 2) To UBound(arr, 2)
                If .Cells(i, 1) = arr(1, arrIndex) Then
                    If InStr(1, arr(4, arrIndex), .Cells(i, 4)) = 0 Then _
                    arr(4, arrIndex) = arr(4, arrIndex) & "-" & .Cells(i, 4)
                    flag = True
                    Exit For
                Else
                    flag = False
                End If
            Next
            If Not flag Then
                x = x + 1
                ReDim Preserve arr(1 To 4, 1 To x)
                arr(1, x) = .Cells(i, 1)
                arr(2, x) = .Cells(i, 2)
                arr(3, x) = .Cells(i, 3)
                arr(4, x) = .Cells(i, 4)
            End If
        Next
    End With
    Sheets.Add
    Range(Cells(1, 1), Cells(UBound(arr, 2), 4)) = Application.Transpose(arr)
    Columns("A ").AutoFit
End Sub

lg Nancy
--
ps: herzerfrischende Aussage, Nicole;-)

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

startrek
Moderator
Architekt


Sehen Sie sich das Profil von startrek an!   Senden Sie eine Private Message an startrek  Schreiben Sie einen Gästebucheintrag für startrek

Beiträge: 1361
Registriert: 13.02.2003

.

erstellt am: 30. Dez. 2006 22:46    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

Ich Fauli habs mal kommentiert, oder zumindest versucht;-)
Code:

Sub test()
    Dim i As Long 'Zeilenzähler
    Dim x As Integer 'Zähler um Arr() zu erweitern
    Dim flag As Boolean
    Dim arr As Variant 'ein DummyArray
    Dim arrIndex As Integer 'der Zähler fürs DummyArray
    With Sheets("Tabelle1")
        'Überschrift und erste Datenzeile in ein Array shreiben
        'transposed also statt Arr(1 to 2, 1 to 4) == Arr (1 to 4, 1 to 2)
        arr = Application.Transpose(Range(.Cells(1, 1), .Cells(2, 4)))
        x = 2
        'Schleife über alle belegten Zeilen in A
        For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
            flag = False
            ' Arr(1 to 4, 1 to x) sukzessive abgleichen mit cells(i,1) also nach der ID
            'wenn ID gefunden im Array > prüfen, ob Comment vorhanden
            'wenn der Comment nicht im Array gefunden (via Instr()) dann anhängen
            For arrIndex = LBound(arr, 2) To UBound(arr, 2)
                If .Cells(i, 1) = arr(1, arrIndex) Then
                    If InStr(1, arr(4, arrIndex), .Cells(i, 4)) = 0 Then _
                    arr(4, arrIndex) = arr(4, arrIndex) & "-" & .Cells(i, 4)
                    'dann Prüfschleife(Arr) verlassen
                    flag = True
                    Exit For
                Else
                    flag = False
                End If
            Next
            'wenn kein Eintrag mit identischer ID in Arr() gefunden wurde
            'Arr() in der letzten Dimension um eins erweitern
            '*Anmerkung: da ein Redim Preserve nur in der letzten Dimension eines Arrays funktioniert,
            'muss man zu Transpose greifen, also man muss aus Arr(1 to row, 1 to column) ein
            'Arr(1 to column, 1 to row) machen, nur so lassen sich die Zeilen in der
            'letzten Dimension 'redim preserven';-)
            If Not flag Then
                x = x + 1
                ReDim Preserve arr(1 To 4, 1 To x)
                arr(1, x) = .Cells(i, 1)
                arr(2, x) = .Cells(i, 2)
                arr(3, x) = .Cells(i, 3)
                arr(4, x) = .Cells(i, 4)
            End If
        Next
    End With
    'sicherheitshalber;-) ein neues Sheet anlegen
    Sheets.Add
    'das transpose Array wieder umtransposen und an den Range im neuen Sheet übergeben
    '*Anmerkung: man kann mit Ubound() auch die Dimensionen des Arrays abfragen
    'Ubound(arr) == Ubound(arr,1), also default
    'mit Ubound(arr,2) kann man explicit die Anzahl der zweiten Dim abfragen
    'dito mit Ubound(arr,3)/ubound(arr,4), für die 3.+4. Dimension
    'aber ab 3 Dimensionen verkriech ich mich eh' gleich wieder zurück in meine dunkle Ecke;-)
    Range(Cells(1, 1), Cells(UBound(arr, 2), 4)) = Application.Transpose(arr)
    'der Grinsemann besteht vehement auf seiner Daseinsberechtigung
    Columns("A  ").AutoFit
End Sub

Application.Transpose() ist also nix andres als, die Wäsche (Jeans) vorm Programmstart umzuwenden und 'linksrum' zu waschen,
vorm Aufhängen auf die Leine (Rangeübergabe) muss man aber wieder 'umwenden' ... ja so in etwa halt ...
(meine Oma hat mir das mal anhand der Wäsche so erklärt,
wusste damals nicht, was das für tiefgreifende Programmiererkenntnisse
nach sich ziehen könnte) 

Gruss, Nancy
--
Documentation, the worst part of programming. 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2896
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 31. Dez. 2006 11:14    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich


Vergleich-index.xls.txt

 
Zitat:
Original erstellt von startrek:
[B]...als, die Wäsche (Jeans) vorm Programmstart umzuwenden und 'linksrum' zu waschen,
vorm Aufhängen auf die Leine (Rangeübergabe) muss man aber wieder 'umwenden' ...

zuckersüss :-)
wobei, die Wäsche, auf der Sichtseite sicherlich 'sauberer' bleibt,
wenn man sie auch noch beim Trocknen auf 'links' lässt ...
- nur spätestens beim Anziehen, sollte man sie wieder wenden 
... aber auch falschrum angezogen, hat so seinen Charm , wenn auch ohne Darm , den das wird erst im Jahr 2014 geslammt:-) 

-back topic-
ich habe auch mal was probiert -Iterationen dazu zulassen- aber hat mir nicht so gefallen und war mir auch nicht sicher ob das die Fragestellung erfüllte :-)

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

startrek
Moderator
Architekt


Sehen Sie sich das Profil von startrek an!   Senden Sie eine Private Message an startrek  Schreiben Sie einen Gästebucheintrag für startrek

Beiträge: 1361
Registriert: 13.02.2003

.

erstellt am: 31. Dez. 2006 14:46    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

Hallo Thomas,

man merkt, da kennt sich einer mit Wäsche aus;-)

Code:

=WENN($I$1=A10;"";WENN($I$1-A10>ZÄHLENWENN(A:A;A10);E10;E10&INDEX(D$1 $100;KKLEINSTE(WENN(A$1:A$100=A10;ZEILE($1:$100));$I$1-A10))))

Das klappt - zwar 00/null/niente/nada Ahnung davon, aber es tut - Hut ab! :-)

So ... langsam beginnt der letzte Abend im Jahr,
ich wünsch dann mal einen guten Rutsch, egal ob sanft oder mit Pauken & Trompeten, Hauptsache ihr kommt gut drüben an, im 2007'er.
Und auf dass es ein Gesundes und Glückliches werde,

Alles Gute,
Nancy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8017
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 31. Dez. 2006 18:05    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

War klar, daß Thomas kurz vor Jahresende noch mit 'ner langweiligen ( ?  ) Formel ums Eck kommen mußte ;-)
wie Nancy schon sagte:  zwar 00/null/niente/nada Ahnung davon, aber es tut - Hut ab!
Respekt, wann bloß denkt man sich so'n Monster aus? 

Ich wünsche euch ein gesundes und erfolgreiches 2007.
Kommt gut rein!

------------------
Gruß,
runkelruebe                         Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2896
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 31. Dez. 2006 19:37    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

so husche
ich auch noch schnell,
kurz vorn Wäsche-ähh!-Jahres-wechsel,
hier herein ;-)

Zwischen Raclett zubereiten und noch bevor das Jahr
mit Schiller und Bekannten ausklingt,

wünsche ich Euch allen ein gutes !Neues - welches Jahr? :-) ,
man liest sich wieder   

PS: auf das!, dass die Antworten immer ein Schmunzeln erzeugen 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

shed777
Mitglied


Sehen Sie sich das Profil von shed777 an!   Senden Sie eine Private Message an shed777  Schreiben Sie einen Gästebucheintrag für shed777

Beiträge: 6
Registriert: 29.12.2006

erstellt am: 02. Jan. 2007 10:15    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


ähm, DANKE alle rechtherzlich für die Antworten. Der Code da unten sieht ziemlich beeindruckend aus für mich als absoluten Makro-Newbie :-) wenn ich diesen allerdings ausführe, bekomm ich immer einen Microsoft Visual Basic "400" Error. Weshalb? bzw. muss ich erst den code auf meine Tabelle anpassen?

 

Zitat:
Original erstellt von runkelruebe:
Ihr mit euren langweiligen Formeln   
is doch viel schöner, wenn's sich automatisch füllt   

Code:
Option Explicit
Public Sub Zusammenfuehren()
Dim i As Long, j As Long, k As Long
Dim Ar(8, 3) As String  ':)ole

'Bereich: Spalten A : D (i+1)
For i = 0 To 3
    'Bereich Zeilen: 2:9 (j+2)
    For j = 0 To 8
        'array füllen mit DatenTabelle
        Ar(j, i) = Tabelle1.Cells(j + 2, i + 1).Value
        If j > 0 Then
        'wenn ID übereinstimmt
        If Ar(j, 0) = Ar(j - 1, 0) Then
            'Spalte E bekommt neuen Eintrag:
            'Tabelle1.Cells(j + 2, 5) = Ar(j - 1, 3)
            If Tabelle1.Cells(j + 1, 5).Value = "" Then
                Tabelle1.Cells(j + 2, 5) = Ar(j - 1, 3)
            Else 'wenn schon einer da war, Spalte F
                Tabelle1.Cells(j + 2, 5) = Tabelle1.Cells(j + 1, 5)
                Tabelle1.Cells(j + 2, 6) = Ar(j - 1, 3)
            End If
            'Kenntlich machen der "überflüssigen" Zeilen
            Tabelle1.Cells(j + 1, 1).Interior.ColorIndex = 3
        End If
        End If
    Next j
Next i
'Wer 's mag, kann auch die überflüssigen Zeilen löschen:
'und wenn wir Zeilen löschen, tun wir das immer rückwärts!
'For k = 10 To 2 Step -1
'    If Tabelle1.Cells(k, 1).Interior.ColorIndex = 3 Then
'        Tabelle1.Cells(k, 1).EntireRow.Delete
'    End If
'Next k
End Sub


Anmerkungen: Array ist an Deine Daten angepaßt: Dim Ar(8, 3) As String
demzufolge auch die Schleifen. Wenn Dein Datenbereich also größer ist, wovon ich ausgehe, mußt Du natürlich diese Bereiche anpassen.
Ich gehe von einer Überschrift in Zeile 1 aus, Daten sind nach ID sortiert und mehr als 3 gleiche ID nacheinander kommen nicht vor.

[e] ich mag keine smilies im code und Zeilen müssen rückwärts gelöscht werden    [/e]


[Diese Nachricht wurde von shed777 am 02. Jan. 2007 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8017
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 02. Jan. 2007 10:25    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

Hallo Markus,
zunächst mal, nimm den code von trekkie, der is schöner ;-)
aber wenn Du bei meinem bleiben willst, an welcher Zeile hängt's denn?
So auf Anhieb, kann ich Dir nicht sagen, wo Du was anpassen mußt...Fehler 400 hab ich selten ;-)

------------------
Gruß,
runkelruebe                         Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

maher02
Mitglied
Sachbearbeiter

Sehen Sie sich das Profil von maher02 an!   Senden Sie eine Private Message an maher02  Schreiben Sie einen Gästebucheintrag für maher02

Beiträge: 1
Registriert: 30.11.2016

erstellt am: 30. Nov. 2016 08:59    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

Hallo

Bei der Suche nach einer Lösung für mein Problem bin ich auf diesen Beitrag gestossen.

Ich habe eine Liste die wie folgt aussieht.

Artikel, Fahrzeug
828-90-021,RBDe 562
828-90-021,ABe
828-90-021,ABt GSW ZB
828-90-021,RBDe 561
828-90-021,RABe 526 SOB
828-90-021A,RBDe 562
828-90-021A,ABe 130 ZB
828-90-021A,ABt GSW ZB
828-90-021A,RBDe 561
828-90-021A,RABe 526 SOB

Anzahl Zeile: 286773
Anzahl Fahrzeuge bei gleiche Artikel: 83

Ich möchte üngefährr dasselbe was in diesem Beitrag diskutiert wurde.

Wenn möglich soll es wenn gleiche "Artikel" vorkommen die einzelnen "Fahrzeuge" in einer Zelle zusammenfassen

Artikel, Fahrzeug, Fahrzeug Zusammengefasst
828-90-021,RBDe 562,RBDe 562;ABe;ABt GSW ZB;RBDe 561;RABe 526
828-90-021,ABe
828-90-021,ABt GSW ZB
828-90-021,RBDe 561
828-90-021,RABe 526 SOB
828-90-021A,RBDe 562
828-90-021A,ABe 130 ZB
828-90-021A,ABt GSW ZB
828-90-021A,RBDe 561
828-90-021A,RABe 526 SOB

Kann man mein Problem mit VBA lösen?

Danke für die Hilfe

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

KlaK
Ehrenmitglied V.I.P. h.c.
Dipl. Ing. Vermessung, CAD- und Netz-Admin



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2162
Registriert: 02.05.2006

Office 2010
Visual Basic

erstellt am: 30. Nov. 2016 12:11    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

Hallo maher02,
Herzlich Willkommen im Forum 

Zu Deiner Frage: Ja kann man!
Man nehme obigen Code, versuche ihn zu verstehen und verändere ihn geringfügig (Anzahl Zeilen/Spalten)

Grüße
Klaus 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Bernd P
Ehrenmitglied V.I.P. h.c.
cook-general



Sehen Sie sich das Profil von Bernd P an!   Senden Sie eine Private Message an Bernd P  Schreiben Sie einen Gästebucheintrag für Bernd P

Beiträge: 3098
Registriert: 07.06.2001

AMD A8-3870, W7-64bit, 16GB RAM, HP DJ T2300mfp, HP DJ 500, Maus:G700s, Sub:Infrastructure Design Suite, Excel 2013,

erstellt am: 30. Nov. 2016 12:29    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

Sehr geil ein Summewenn mit Text.....

@maher02, anbei die Anpassung, aber nur weil ich den Beitrag von 2006 nicht gesehen habe und ich das Teil schon angepasst hab 

Code:
Sub test()
    Dim i As Long 'Zeilenzähler
    Dim x As Integer 'Zähler um Arr() zu erweitern
    Dim flag As Boolean
    Dim arr As Variant 'ein DummyArray
    Dim arrIndex As Integer 'der Zähler fürs DummyArray
    With Sheets("Tabelle1")
        'Überschrift und erste Datenzeile in ein Array shreiben
        'transposed also statt Arr(1 to 2, 1 to 2) == Arr (1 to 2, 1 to 2)
        arr = Application.Transpose(Range(.Cells(1, 1), .Cells(2, 2)))
        x = 2
        'Schleife über alle belegten Zeilen in A
        For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
            flag = False
            'Arr(1 to 2, 1 to x) sukzessive abgleichen mit cells(i,1) also nach der ID
            'wenn ID gefunden im Array > prüfen, ob Comment vorhanden
            'wenn der Comment nicht im Array gefunden (via Instr()) dann anhängen
            For arrIndex = LBound(arr, 2) To UBound(arr, 2)
                If .Cells(i, 1) = arr(1, arrIndex) Then
                    If InStr(1, arr(2, arrIndex), .Cells(i, 2)) = 0 Then _
                    arr(2, arrIndex) = arr(2, arrIndex) & ";" & .Cells(i, 2)
                    'dann Prüfschleife(Arr) verlassen
                    flag = True
                    Exit For
                Else
                    flag = False
                End If
            Next
            'wenn kein Eintrag mit identischer ID in Arr() gefunden wurde
            'Arr() in der letzten Dimension um eins erweitern
            '*Anmerkung: da ein Redim Preserve nur in der letzten Dimension eines Arrays funktioniert,
            'muss man zu Transpose greifen, also man muss aus Arr(1 to row, 1 to column) ein
            'Arr(1 to column, 1 to row) machen, nur so lassen sich die Zeilen in der
            'letzten Dimension 'redim preserven';-)
            If Not flag Then
                x = x + 1
                ReDim Preserve arr(1 To 2, 1 To x)
                arr(1, x) = .Cells(i, 1)
                arr(2, x) = .Cells(i, 2)
                'arr(3, x) = .Cells(i, 3)
                'arr(4, x) = .Cells(i, 4)
            End If
        Next
    End With
    'sicherheitshalber;-) ein neues Sheet anlegen
    Sheets.Add
    'das transpose Array wieder umtransposen und an den Range im neuen Sheet übergeben
    '*Anmerkung: man kann mit Ubound() auch die Dimensionen des Arrays abfragen
    'Ubound(arr) == Ubound(arr,1), also default
    'mit Ubound(arr,2) kann man explicit die Anzahl der zweiten Dim abfragen
    'dito mit Ubound(arr,3)/ubound(arr,2), für die 3.+2. Dimension
    'aber ab 3 Dimensionen verkriech ich mich eh' gleich wieder zurück in meine dunkle Ecke;-)
    Range(Cells(1, 1), Cells(UBound(arr, 2), 2)) = Application.Transpose(arr)
    'der Grinsemann besteht vehement auf seiner Daseinsberechtigung
    Columns("A:Z").AutoFit
End Sub

------------------
<----- Bitte Systeminfo eintragen, warum siehst du hier.

Schöne Grüsse aus der Steiermark  Bernd P.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2896
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 30. Nov. 2016 18:09    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich


Vergleich-indexdiezwote.zip

 
Nur zwecks der Formelgleichberechtigung {unabhängig der m/f/d/x Berechtigung} :-)

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

thequilla23
Mitglied


Sehen Sie sich das Profil von thequilla23 an!   Senden Sie eine Private Message an thequilla23  Schreiben Sie einen Gästebucheintrag für thequilla23

Beiträge: 3
Registriert: 31.01.2019

erstellt am: 31. Jan. 2019 12:24    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

Hi zusammen,

dieser Artikel hat mir bei meiner Googlesuche am meißten geholfen, deshalb hoffe ich dass ihr mein Leben vielleicht erleichten könnt.
Meine VB-Kenntnisse sind leider dermaßen eingerostet, sodass ich es partout nicht schaffe den Code auf meine Bedürfnisse anzupassen.
Ich muss wöchentlich eine etwas größere Tabelle per Pivotfunktion "konsolidieren" und händisch dauert es einfach ewig.

Ich hab folgende Ausgangslage:

    A B C D E F G H I J K L 
3  
...
594

Sofern die Inhalte in den Spalten A bis J gleich sind, müssten diese zusammengefasst werden und die Summen der Werte in K und L abgebildet werden. K enthält beispielsweise einen Rechnungswert und L den Einkaufswert des verkauften Produktes.
Die Anzahl der Zeilen variert von Woche zu Woche. Die zu analysierenden Werte beginnen aber stets in Zeile 4. Zeile 3 beinhaltet Spaltenüberschriften.

Sofern also A-J identisch in den Zeilen 4-594 identisch sind, sollen diese zusammengefasst werden und die Summen in K und L abgebildet werden.

Da die Lösung den hier erwähnten Fällen sehr nahe kommt, hoffe ich auf eure Unterstützung  

[Diese Nachricht wurde von thequilla23 am 31. Jan. 2019 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

KlaK
Ehrenmitglied V.I.P. h.c.
Dipl. Ing. Vermessung, CAD- und Netz-Admin



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2162
Registriert: 02.05.2006

Office 2010
Visual Basic

erstellt am: 31. Jan. 2019 13:13    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

Hallo Thequilla,
Willkommen im Forum 
So ganz habe ich Deine Ausgangslage noch nicht verstanden
Die Spalten A-J sind gleich? Warum hat man dann unterschiedliche Spalten? Vermutlich meinst Du wenn in den aufeinanderfolgenden Zeilen die Werte gleich sind (warum auch immer)
Stehen in K und L bereits Rechnungs-/Einkaufswerte und sollen diese Summen in neue Spalten M und N des letzten Wertes geschrieben werden oder eine neue Tabelle erzeugt werden mit nur den zusammengefassten Werten?
Etwas 

Grüße
Klaus   

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

thequilla23
Mitglied


Sehen Sie sich das Profil von thequilla23 an!   Senden Sie eine Private Message an thequilla23  Schreiben Sie einen Gästebucheintrag für thequilla23

Beiträge: 3
Registriert: 31.01.2019

erstellt am: 31. Jan. 2019 13:38    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

Hi KlaK,

ich habe mich eindeutig falsch ausgedrückt.

A-J enthalten Informationen wie Verkaufsort, Verkaufskanal, Verkaufsdatum, Bezahldatum, etc.. Es kommt also oft vor, dass die Werte dort gleich sind, und K bw. L unterschiedliche Werte ausweisen. Produkte werden oft über den gleichen Weg, am gleichen Tag, aber zu unterschiedlichen Preisen verkauft.

Ich bräuchte im Optimalfall dann eine neue Tabelle mit zusammengefassten Werten. Sofern alle Werte in A-J gleich sind, soll es diesen Eintrag auch nur noch einmal in einer neuen Tabelle geben  .

Ist das überhaupt möglich?

Danke!!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

KlaK
Ehrenmitglied V.I.P. h.c.
Dipl. Ing. Vermessung, CAD- und Netz-Admin



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2162
Registriert: 02.05.2006

Office 2010
Visual Basic

erstellt am: 31. Jan. 2019 14:04    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

Hallo Thequilla,
Das sollte mit einer einfachen Pivot-Tabelle jetzt schon möglich sein
Markiere mal die Spalten A-L und erzeuge eine Pivottabelle (neues Tabellenblatt)
dann die Spalten A-J als Zeilenbeschriftung (Häkchen in der Feldliste)
Spalten K und L ins Wertefenster ziehen und Anzahl auf Summe ändern

Wenn Du jetzt noch in die Optionen der Pivottabelle gehst und die Ergebnissummen nicht darstellen lässt sollte es eigentlich die gewünschte Form haben

Grüße
Klaus 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

thequilla23
Mitglied


Sehen Sie sich das Profil von thequilla23 an!   Senden Sie eine Private Message an thequilla23  Schreiben Sie einen Gästebucheintrag für thequilla23

Beiträge: 3
Registriert: 31.01.2019

erstellt am: 31. Jan. 2019 15:53    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für shed777 10 Unities + Antwort hilfreich

Warum einfach, wenn es auch kompliziert geht.

Danke dir!!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2020 CAD.de | Impressum | Datenschutz