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

Code anpassen zur Überprüfung der Anfangsziffern

Code anpassen zur Überprüfung der Anfangsziffern
10.01.2018 12:36:04
Rahel
Hallo liebes Forum,
ich versuche gerade diesen Code so anzupassen, dass er Folgendes tut:
In beigefügter Tabelle soll er in Spalte B (IPC) in jeder Zeile die ersten 4 Ziffern prüfen - wenn es immer die gleichen ersten vier Ziffern sind soll in Spalte C eine "1" ausgegeben werden. Wenn es unterschiedliche sind soll im besten Fall (falls möglich) die Anzahl der unterschiedlichen Kombinationen ausgegeben werden. (also z.B. in C4 eine "3" da drei unterschiedliche 4er Anfangskombinationen)
Sub Main()
Dim B As String
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
Tx = Split(Cells(i, 2), Chr(10))
B = ""
For k = 0 To UBound(Tx)
If InStr(1, B, Left(Tx(i), 4)) = 0 Then B = B & "," & Left(Tx(k), 4)
Next k
Cells(i, 7) = Len(B) / 5
Next i
End Sub
Daniel und Fennek haben bereits Tips gegeben, aber ich komme hier leider alleine nicht weiter.
Userbild
Vielen vielen Dank !!
Rahel

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Code anpassen zur Überprüfung der Anfangsziffern
10.01.2018 12:45:32
Daniel
du bist ja nicht allein.
du hast inzwischen auch genügend Tips bekommen, um auch bei bescheidenen VBA-Kenntnissen den Fehler zu finden.
ein bisschen Eigeninitiative solltest du schon zeigen.
Gruß Daniel
Code zur Überprüfung der Anfangszeichen
10.01.2018 12:47:55
Rudi
Hallo,
du meinst die ersten 4 Zeichen, nicht Ziffern.
Sub Main()
Dim objCheck As Object
Dim i As Long, k As Long, Tx
Set objCheck = CreateObject("scripting.dictionary")
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
Tx = Split(Cells(i, 2), Chr(10))
For k = 0 To UBound(Tx)
objCheck(Left(Tx(k), 4)) = 0
Next k
Cells(i, 3) = objCheck.Count
objCheck.RemoveAll
Next i
End Sub

Gruß
Rudi
Anzeige
Zeichen prüfen schnell
10.01.2018 13:00:16
Rudi
Hallo,
&lt1Sek/20000 Zellen:
Sub Main()
Dim objCheck As Object
Dim arrIn, arrTmp, TX, arrCount()
Dim i As Long
Set objCheck = CreateObject("scripting.dictionary")
arrIn = Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
ReDim arrCount(1 To UBound(arrIn), 1 To 1)
For i = 1 To UBound(arrIn)
arrTmp = Split(arrIn(i, 1), Chr(10))
For Each TX In arrTmp
objCheck(Left(TX, 4)) = 0
Next TX
arrCount(i, 1) = objCheck.Count
objCheck.RemoveAll
Next i
Cells(2, 3).Resize(UBound(arrCount)) = arrCount
End Sub

Gruß
Rudi
AW: Zeichen prüfen schnell
10.01.2018 15:41:54
Rahel
Hallo Rudi,
Tausend Dank!!!! Das funktioniert, der erste Code hat tatsächlich ewig gebraucht und sich irgendwann aufgehängt aber der Zweite funktioniert super.
Einziges "Problem" ist, dass er mir immer eins zu viel zählt - weißt du woran das liegt? Also wenn es nur eine 4er Kombination gibt, gibt er mir "2" aus usw.
Theoretisch ist das kein Problem, weil ich ja einfach immer 1 abziehen kann aus allen Zellen. Würde mich nur interessieren, woran das liegt.
Vielen vielen Dank, ich bin so oder so begeistert und sehr dankbar!
Rahel
Anzeige
AW: Zeichen prüfen schnell
10.01.2018 16:43:16
Rudi
Hallo,
Bei mir wird richtig gezählt. Möglicherweise hängt bei dir noch ein Zeilenumbruch an.
    For Each TX In arrTmp
If Len(TX) Then objCheck(Left(TX, 4)) = 0
Next TX
Gruß
Rudi
AW: Zeichen prüfen schnell
10.01.2018 18:05:52
Rahel
Hallo Rudi,
genau das wars! Ich danke dir ganz herzlich. Bin total begeistert :-)
Rahel

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige