Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1664to1668
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

Spalte durchlaufen, Teilstring suchen & Häufigkeit

Spalte durchlaufen, Teilstring suchen & Häufigkeit
09.01.2019 13:46:19
Anna
Hallo zusammen,
ich versuche gerade eine Spalte zu durchlaufen in der sich Zeichenketten befinden und diese zu vergleichen und anschließend herauszufinden, wie häufig diese in der Spalte vorkommen.
Die Zeichenketten setzten sich aus Zahlen zusammen: 001-00043-00800 usw.
Ich möchte nun vergleichen ab Zeichen 4 - 15, wie oft sich in der Spalte Zeichenketten ab Zeichen 4-15 wiederholen, unabhängig also von Zeichen "001-"
Bis jetzt habe ich es geschafft herauszufinden, welche gesamten Zeichenkette sich in der Spalte wiederholen also Zeichen 1-15 und dieses wird mir dann in Spalte E ausgegeben.
Kann mir jmd helfen & mir auch erklären wie ich die Häufigkeit feststellen kann?
Bisher mache ich es so:

Sub test()
Dim lZeile, i, Zähler As Double
Dim Treffer(100000) As String
lZeile = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
Zähler = 0
For i = 1 To lZeile
If IsError(Application.Match(Cells(i, 1), Treffer(), 0)) Then
Zähler = Zähler + 1
Treffer(Zähler) = Cells(i, 1)
End If
Next
For i = 1 To Zähler
Cells(i, 5) = Treffer(i)  'Liste wird in Spalte E zurückgeschrieben
Next
End Sub


Meine Datei habe ich angehängt:
https://www.herber.de/bbs/user/126594.zip
Vielen Dank für eure Hilfe!

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalte durchlaufen
09.01.2019 14:05:13
Rudi
Hallo,
ohne deine Datei gesehen zu haben:
Sub aaaa()
Dim objCounter As Object, rngC As Range, sTmp
Set objCounter = CreateObject("scripting.dictionary")
With Sheets(1)
For Each rngC In .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
sTmp = Right(rngC, 11)
objCounter(sTmp) = objCounter(sTmp) + 1
Next rngC
End With
Cells(1, 5).Resize(objCounter.Count) = Application.Transpose(objCounter.keys)   'Teilstrings
Cells(1, 6).Resize(objCounter.Count) = Application.Transpose(objCounter.items)  'Anzahl
End Sub

Gruß
Rudi
AW: Spalte durchlaufen
09.01.2019 14:25:11
Nepumuk
Hallo Rudi,
die Zelle A1 ist leer.
Gruß
Nepumuk
Anzeige
wie gesagt, ....
09.01.2019 14:44:11
Rudi
Hallo,
... habe ich mir die Datei nicht angeschaut.
Anna ist die Spalte auch ab A1 durchgelaufen.
Gruß
Rudi
AW: Spalte durchlaufen
09.01.2019 14:31:40
Anna
Hallo Rudi,
vielen Dank für deine Antwort! Bei der Beispieldatei ist zwar die Zelle A1 leer, aber ansonsten funktioniert dein Makro prima. Vielen Dank! Bei Gelegenheit werde ich mich mit Dictionary näher befassen, ist aufjeden Fall sehr hilfreich!
Liebe Grüße
ohne Schleife
09.01.2019 14:25:10
UweD
Hallo
vielleicht über diesen Weg
Sub Neu()
    Dim lZeile As Double, ZSp As Integer, Z1 As Integer
    
    With Sheets("Tabelle1")
        lZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
        ZSp = 5 ' Zielspalte 
        Z1 = 2 'Erste Zeile mit Daten 
    
        .Columns(1).Copy .Columns(ZSp)
        .Columns(ZSp).TextToColumns Destination:=.Cells(1, ZSp), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 9), Array(4, 1))
    
    
        .Columns(ZSp).RemoveDuplicates Columns:=1, Header:=xlNo
    
        lZeile = .Cells(.Rows.Count, ZSp).End(xlUp).Row
        With .Cells(Z1, ZSp + 1).Resize(lZeile - Z1 + 1)
            .FormulaR1C1 = "=COUNTIF(C[-5],""?""&RC[-1])"
            .Value = .Value
        End With
    End With
End Sub
Dabei läuft das ab
- Spalte kopieren
- Text in Spalten und dabei die ersten 4 Zeichen weglassen
- Duplikate entfernen
- Zählenwenn Formel verwenden
- Formeln in Werte umwandeln
LG UweD
Anzeige
AW: ohne Schleife
09.01.2019 14:34:23
Anna
Hallo Uwe,
vielen Dank für deine Antwort! Dein Code klappt prima, auch ohne Schleife :) Vielen lieben Dank auch für die Erklärung des Ablaufs!
Liebe Grüße
gern geschehen owT
09.01.2019 14:35:11
UweD

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige