Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Vergleiche innerhalb eines Dictionarys
zurück: bedingte Formatierungen in VBA umwandeln weiter: komplexe Suche und Zählungen Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Antwort Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
mausi181987
Im Profil kannst Du frei den Rang ändern


Verfasst am:
24. Apr 2014, 09:16
Rufname:

Vergleiche innerhalb eines Dictionarys - Vergleiche innerhalb eines Dictionarys

Nach oben
       Version: Office 2003

Hallo,
ich habe folgendes Problem.
Ich habe eine Spalte in der verschiedene Buchstabenkombination stehen mit dazugehörigen Beschreibungstext.
Wenn mehr als 1 Buchstabe in einer Zeile steht, sollen die Buchstabenkombinationen zerlegt werden und dann in dem Bereich geprüft werden, ob die Buchstaben jeweils einzeln vorkommen und dann jeweils ein bestimmter Text zurückgegeben werden. Ich dachte ein Dictionary wäre eine gute Idee. Leider weiß ich nicht, wie ich Vergleiche anstelle.
Anhand einer Tabelle wird es sicherlich verständlicher:

Buchstaben|Text
==============
AB |Versand
A |50021
B |Prüfung
C |Reparatur
AB |Versand
ABC|Eingang
BCD|Reinigung

Jetzt müsste quasi AB zerlegt werden in A und B, geprüft werden, ob A in dem Bereich einzeln vorkommt und der Text "50021" muss gemerkt werden. Das gleiche für B. Es muss geprüft werden, ob B einzeln vorkommt und der Text "Prüfung" muss gemerkt haben. Wenn jetzt einer der gemerkten Texte (könnten ja auch mal 3 oder 4 sein) mit einer 5 anfängt (hier 50021), dann möchte ich diesen Text (höhere Priorität) in eine neue Spalte dahinter geschrieben haben inkl. aller vorkommenden Buchstaben, ansonsten den Text vom 1. Buchstaben. Bei Buchstaben, die einzeln sind, bleibt alles wie gehabt.

Hier die Ergebnistabelle:

Buchstaben|Text|Ergebnisspalte
==========================
AB |Versand |AB - 50021
A |50021 |A - 50021
B |Prüfung |B - Prüfung
C |Reparatur |C - Reparatur
AB |Versand |AB - 50021
ABC |Eingang |ABC - 50021
BCD |Reinigung |BC - Prüfung

Über Hilfe wäre ich Euch wahnsinnig dankbar!!!

Grüße,
Katharina
Isabelle :-)
Menschin


Verfasst am:
24. Apr 2014, 10:04
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis

AW: Vergleiche innerhalb eines Dictionarys - AW: Vergleiche innerhalb eines Dictionarys

Nach oben
       Version: Office 2003

Hallöchen,

es ginge, je nach Datenmenge, auch ohne Dictionary, nur mit 2 Arrays. Den Unterschied würdest du ab 100.000 Zeilen aufwärts merken, erst ab da wäre das Dictionary wahrscheinlich schneller (geschätzt nicht verifiziert).

In ein Standardmodul:

Code:
Option Explicit

Public Sub KeyAnalysis()

    Const START_ROW As Long = 1 'Startzeile der Daten - Anpassen !!!!!!!!!!!!!!!!!!!!!!!!!!!!

    Dim avntInput As Variant, avntOutput() As Variant
    Dim ialngIndex As Long, lngCharacter As Long
    Dim strCharacters As String, strOutputCharacter As String, strOutputValue As String
    Dim objDictionary As Object

    With Tabelle1
        avntInput = .Range(.Cells(START_ROW, 1), .Cells(.Rows.Count, 2).End(xlUp)).Value2
    End With

    ReDim avntOutput(1 To UBound(avntInput), 0 To 0)

    Set objDictionary = CreateObject(Class:="Scripting.Dictionary")

    For ialngIndex = 1 To UBound(avntInput)
        objDictionary.Item(avntInput(ialngIndex, 1)) = avntInput(ialngIndex, 2)
    Next

    With objDictionary

        For ialngIndex = 1 To UBound(avntInput)

            strCharacters = avntInput(ialngIndex, 1)

            If Len(strCharacters) > 1 Then

                strOutputCharacter = vbNullString
                strOutputValue = vbNullString

                For lngCharacter = 1 To Len(strCharacters)

                    If .Exists(Mid$(strCharacters, lngCharacter, 1)) Then

                        strOutputCharacter = strOutputCharacter & Mid$(strCharacters, lngCharacter, 1)

                        If Left$(CStr(.Item(Mid$(strCharacters, lngCharacter, 1))), 1) = "5" Then

                            strOutputValue = .Item(Mid$(strCharacters, lngCharacter, 1))

                        Else

                            If strOutputValue = vbNullString Then _
                                strOutputValue = .Item(avntInput(ialngIndex, 1))

                        End If
                    End If
                Next

                avntOutput(ialngIndex, 0) = strOutputCharacter & " - " & strOutputValue

            Else

                avntOutput(ialngIndex, 0) = strCharacters & " - " & .Item(avntInput(ialngIndex, 1))

            End If
        Next
    End With

    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Cells(START_ROW, 3).Resize(UBound(avntOutput), 1).Value2 = avntOutput

    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set objDictionary = Nothing

End Sub

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%
mausi181987
Im Profil kannst Du frei den Rang ändern


Verfasst am:
24. Apr 2014, 10:38
Rufname:

AW: Vergleiche innerhalb eines Dictionarys - AW: Vergleiche innerhalb eines Dictionarys

Nach oben
       Version: Office 2003

Hallo Isabelle,

das funktioniert - soweit ich es jetzt ausprobiert habe - super!!!! Wie gesagt ich muss es nochmal weiter testen.
Das einzige, was mir momentan schon mal auffällt, ich habe auch den Fall, dass in der Spalte A, wo avntInput eingelesen wird, auch Leerzeilen dazwischen sind. Da wirft der Code dann natürlich einen Fehler, kann ich das umgehen, dass die nicht mtieingelsen werden?

Grüße,
Katharina
Isabelle :-)
Menschin


Verfasst am:
24. Apr 2014, 10:57
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis

AW: Vergleiche innerhalb eines Dictionarys - AW: Vergleiche innerhalb eines Dictionarys

Nach oben
       Version: Office 2003

Hallöchen,

so besser?

Code:
Option Explicit

Public Sub KeyAnalysis()

    Const START_ROW As Long = 1 'Startzeile der Daten - Anpassen !!!!!!!!!!!!!!!!!!!!!!!!!!!!

    Dim avntInput As Variant, avntOutput() As Variant
    Dim ialngIndex As Long, lngCharacter As Long
    Dim strCharacters As String, strOutputCharacter As String, strOutputValue As String
    Dim objDictionary As Object

    With Tabelle1
        avntInput = .Range(.Cells(START_ROW, 1), .Cells(.Rows.Count, 2).End(xlUp)).Value2
    End With

    ReDim avntOutput(1 To UBound(avntInput), 0 To 0)

    Set objDictionary = CreateObject(Class:="Scripting.Dictionary")

    For ialngIndex = 1 To UBound(avntInput)
        If Not IsEmpty(avntInput(ialngIndex, 1)) Then _
            objDictionary.Item(avntInput(ialngIndex, 1)) = avntInput(ialngIndex, 2)
    Next

    With objDictionary

        For ialngIndex = 1 To UBound(avntInput)

            If Not IsEmpty(avntInput(ialngIndex, 1)) Then

                strCharacters = avntInput(ialngIndex, 1)

                If Len(strCharacters) > 1 Then

                    strOutputCharacter = vbNullString
                    strOutputValue = vbNullString

                    For lngCharacter = 1 To Len(strCharacters)

                        If .Exists(Mid$(strCharacters, lngCharacter, 1)) Then

                            strOutputCharacter = strOutputCharacter & Mid$(strCharacters, lngCharacter, 1)

                            If Left$(CStr(.Item(Mid$(strCharacters, lngCharacter, 1))), 1) = "5" Then

                                strOutputValue = .Item(Mid$(strCharacters, lngCharacter, 1))

                            Else

                                If strOutputValue = vbNullString Then _
                                    strOutputValue = .Item(avntInput(ialngIndex, 1))

                            End If
                        End If
                    Next

                    avntOutput(ialngIndex, 0) = strOutputCharacter & " - " & strOutputValue

                Else

                    avntOutput(ialngIndex, 0) = strCharacters & " - " & .Item(avntInput(ialngIndex, 1))

                End If
            End If
        Next
    End With

    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Cells(START_ROW, 3).Resize(UBound(avntOutput), 1).Value2 = avntOutput

    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set objDictionary = Nothing

End Sub

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%
mausi181987
Im Profil kannst Du frei den Rang ändern


Verfasst am:
24. Apr 2014, 14:38
Rufname:

AW: Vergleiche innerhalb eines Dictionarys - AW: Vergleiche innerhalb eines Dictionarys

Nach oben
       Version: Office 2003

Hallo,

vielen lieben Dank. Das funktioniert topp!!!
Eine kleine Änderung habe ich noch. Hab es selber versucht, leider scheitere ich.
Und zwar möchte ich, wenn ein Buchstabe nicht gefunden wird. In der eigentlichen ausgabespalte nichts steht und dafür in der Spalte daneben der Buchstabe, der nicht gefunden wurde. D.h. ich müsste das Ausgabearray 2 Spaltig machen odeR?

Grüße,
Katharina
Isabelle :-)
Menschin


Verfasst am:
24. Apr 2014, 15:10
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis

AW: Vergleiche innerhalb eines Dictionarys - AW: Vergleiche innerhalb eines Dictionarys

Nach oben
       Version: Office 2003

Hallöchen,

wenn ABC drin steht, A und B gefunden wurden dann soll in Spalte C z.B. A - 50021 stehen und in Spalte D der nicht gefundene Buchstabe C. Oder soll die Spalte C trotzdem frei bleiben?

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%
mausi181987
Im Profil kannst Du frei den Rang ändern


Verfasst am:
24. Apr 2014, 15:12
Rufname:

AW: Vergleiche innerhalb eines Dictionarys - AW: Vergleiche innerhalb eines Dictionarys

Nach oben
       Version: Office 2003

Die Spalte C sollte dann frei bleiben!
Isabelle :-)
Menschin


Verfasst am:
24. Apr 2014, 15:23
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis

AW: Vergleiche innerhalb eines Dictionarys - AW: Vergleiche innerhalb eines Dictionarys

Nach oben
       Version: Office 2003

Hallöchen,

es wäre schön, wenn du in Zukunft das alles vorher überlegst, denn keiner hat Lust immer wieder nachbessern, außer er wird dafür bezahlt.

Code:
Option Explicit

Public Sub KeyAnalysis()

    Const START_ROW As Long = 1 'Startzeile der Daten - Anpassen !!!!!!!!!!!!!!!!!!!!!!!!!!!!

    Dim avntInput As Variant, avntOutput() As Variant
    Dim ialngIndex As Long, lngCharacter As Long
    Dim strCharacters As String, strOutputCharacter As String
    Dim strOutputValue As String
    Dim blnNotFound As Boolean
    Dim objDictionary As Object

    With Tabelle1
        avntInput = .Range(.Cells(START_ROW, 1), _
            .Cells(.Rows.Count, 2).End(xlUp)).Value2
    End With

    ReDim avntOutput(1 To UBound(avntInput), 1 To 2)

    Set objDictionary = CreateObject(Class:="Scripting.Dictionary")

    For ialngIndex = 1 To UBound(avntInput)
        If Not IsEmpty(avntInput(ialngIndex, 1)) Then _
            objDictionary.Item(avntInput(ialngIndex, 1)) = avntInput(ialngIndex, 2)
    Next

    With objDictionary

        For ialngIndex = 1 To UBound(avntInput)

            If Not IsEmpty(avntInput(ialngIndex, 1)) Then

                strCharacters = avntInput(ialngIndex, 1)

                If Len(strCharacters) > 1 Then

                    strOutputCharacter = vbNullString
                    strOutputValue = vbNullString
                    blnNotFound = False

                    For lngCharacter = 1 To Len(strCharacters)

                        If .Exists(Mid$(strCharacters, lngCharacter, 1)) Then

                            strOutputCharacter = strOutputCharacter & _
                                Mid$(strCharacters, lngCharacter, 1)

                            If Left$(CStr(.Item(Mid$(strCharacters, _
                                lngCharacter, 1))), 1) = "5" Then

                                strOutputValue = .Item(Mid$(strCharacters, lngCharacter, 1))

                            Else

                                If strOutputValue = vbNullString Then _
                                    strOutputValue = .Item(avntInput(ialngIndex, 1))

                            End If
                        Else

                            blnNotFound = True

                            avntOutput(ialngIndex, 2) = _
                                Mid$(strCharacters, lngCharacter, 1)

                            Exit For

                        End If
                    Next

                    If Not blnNotFound Then _
                        avntOutput(ialngIndex, 1) = _
                            strOutputCharacter & " - " & strOutputValue

                Else

                    If Not blnNotFound Then avntOutput(ialngIndex, 1) = _
                        strCharacters & " - " & .Item(avntInput(ialngIndex, 1))

                End If
            End If
        Next
    End With

    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Cells(START_ROW, 3).Resize(UBound(avntOutput), 2).Value2 = avntOutput

    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set objDictionary = Nothing

End Sub

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%
mausi181987
Im Profil kannst Du frei den Rang ändern


Verfasst am:
28. Apr 2014, 14:57
Rufname:

AW: Vergleiche innerhalb eines Dictionarys - AW: Vergleiche innerhalb eines Dictionarys

Nach oben
       Version: Office 2003

Hallo Isabelle,

vielen, vielen lieben Dank! Nun ist es wirklich genau das, was ich wollte. Ich werde versuchen das nächste Mal gleich alle Fälle mit abzudecken bzw. das nächste Mal hoffentlich selber hinbekommen. Hab jetzt wieder einiges dazugelernt.
Großes DANKE nochmal.

Grüße,
Katharina
mausi181987
Im Profil kannst Du frei den Rang ändern


Verfasst am:
29. Apr 2014, 14:27
Rufname:

AW: Vergleiche innerhalb eines Dictionarys - AW: Vergleiche innerhalb eines Dictionarys

Nach oben
       Version: Office 2003

Hallo Isabelle,

ich habe noch ein letztes Anliegen. ich komme absolut nicht weiter. Du weist wahrscheinlich gleich auf Anhieb, wie ich das Problem löse.
Und zwar habe ich dein Makro jetzt etwas angepasst und lasse es immer über einen bestimmten Zeilenbereich laufen.
Nun habe ich einen Ausnahmefall, wo das Range nur aus einer Zeile besteht und (weiß nicht, ob das Relevant ist, weil bei einem größeren Bereich funktioniert es auch) die einzulesenden Spalten leer sind.
Ich bekomme einen Lauifzeitfehler 13 - Typen unverträglichkeit

Code:

'Mögliche Pakete pro Order einlesen
RngInput = Union(ThisWorkbook.Worksheets("IW49").Range("AJ" & z & ":AJ" & y), _ThisWorkbook.Worksheets("IW49").Range("AN" & z & ":AO" & y)).Value2

 ReDim RngOutput(1 To UBound(RngInput), 1 To 2)


"RngInput" ist dann leer und deshalb funktioniert sicherlich auch das ReDim nicht. Ich habe versucht zu prüfen, ob das Array leer ist. Ich bekomme es einfach nicht hin.
Falls du mir nochmal helfen könntest, wäre ich dir sehr dankbar.

Grüße,
KAtharina
Isabelle :-)
Menschin


Verfasst am:
30. Apr 2014, 09:16
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis

AW: Vergleiche innerhalb eines Dictionarys - AW: Vergleiche innerhalb eines Dictionarys

Nach oben
       Version: Office 2003

Hallöchen,

wenn das nur eine Zelle ist, dann enthält die Value-Eigenschaft kein Array sondern den einzelnen Wert der Zelle. Du kannst jetzt überall im Code eine Abfrage einbauen und den Einzelwert vom Array zu unterscheiden, oder du erzeugst ein künstliches Array. Die zweite Möglichkeit hat den Vorteil das alles was danach auf das Array zugreift nicht geändert werden muss und du nur eine einzige Abfrage benötigst.

Dazu ein Beispiel zum selbereinbauen:

Code:
Public Sub Beispiel()

    Dim avntValues As Variant, vntTemp As Variant

    'Wert einer einzelnen Zelle übergeben
    avntValues = Range(Cells(1, 1), Cells(1, 1)).Value2

    'Prüfen ob ein Array übergeben wurde
    If Not IsArray(avntValues) Then

        'Wert an temporäre Variable übergeben
        vntTemp = avntValues

        'Aus der Variablen ein Array für eine Zelle erzeugen
        ReDim avntValues(1 To 1, 1 To 1)

        'Wert aus temporären Variablen an das Array übergeben
        avntValues(1, 1) = vntTemp

    End If
End Sub

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel VBA (Makros): Vergleiche mit Zufallszahlen 2 go4vba 92 18. Feb 2014, 06:31
Gast Vergleiche mit Zufallszahlen
Keine neuen Beiträge Excel Formeln: Mehrere Spalten miteinander vergleiche 3 Smile 90 29. Okt 2013, 21:05
lupo1 Mehrere Spalten miteinander vergleiche
Keine neuen Beiträge Excel Formeln: VERGLEICHE 8 Ziffern in EINER >1 Spalte mit Funktionen 10 FreundExcel 90 07. März 2013, 19:55
HermannZ VERGLEICHE 8 Ziffern in  EINER >1 Spalte mit Funktionen
Keine neuen Beiträge Excel VBA (Makros): VBA - Vergleiche von Spalten und Ergebnispräsentation 3 VBA-Dödl 88 15. Feb 2013, 22:19
Grüßli VBA - Vergleiche von Spalten und Ergebnispräsentation
Keine neuen Beiträge Excel Formeln: Zwei Tabellen vergleiche, dublikate finden und markieren 1 Excel_Nils 81 15. Feb 2013, 12:16
steve1da Zwei Tabellen vergleiche, dublikate finden und markieren
Keine neuen Beiträge Excel VBA (Makros): Vergleiche und Lösche 10 Lande88 98 01. Feb 2013, 14:05
Phelan XLPH Vergleiche und Lösche
Keine neuen Beiträge Excel Formeln: Vergleiche zwei Spalten mit Text und aufzeigen wo gleich 3 Reile 594 27. März 2012, 20:53
shift-del Vergleiche zwei Spalten mit Text und aufzeigen wo gleich
Keine neuen Beiträge Excel VBA (Makros): Vergleiche zwei Spalten und markiere Abweichungen 15 Gast 596 19. März 2012, 21:11
Gast Vergleiche zwei Spalten und markiere Abweichungen
Keine neuen Beiträge Excel Formeln: Vergleiche 2 Excelisten/Personalabgänge/zuänge 19 Aladin87 895 22. Jul 2010, 12:57
Gast Vergleiche 2 Excelisten/Personalabgänge/zuänge
Keine neuen Beiträge Excel Formeln: werte vergleiche + leere felder 1 leftside 185 08. Jun 2010, 11:43
peterchen1 werte vergleiche + leere felder
Keine neuen Beiträge Excel VBA (Makros): doppelte/redundante Zeilen löschen; vergleiche Spalte A - F 2 Svea 1301 30. Jan 2010, 19:56
Svea doppelte/redundante Zeilen löschen; vergleiche Spalte A - F
Keine neuen Beiträge Excel VBA (Makros): Erst ausführen wenn alle vergleiche nicht übereinstimmen 6 René00 400 02. Okt 2009, 13:45
Gast Erst ausführen wenn alle vergleiche nicht übereinstimmen
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Macromedia Dreamweaver