Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
696to700
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
696to700
696to700
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Aus Zellen "unikate" Ziffern auslesen

Aus Zellen "unikate" Ziffern auslesen
21.11.2005 10:48:49
urs
Guten Morgen allerseits
Nach diversen Eigen-Versuchen übers Wochenende ergab sich folgendes Problem als Forumsanfrage.
Aus einem bestimmten Zellenbereich sollen per VBA die Ziffern herauskopiert werden, die im ganzen Bereich einmalig sind. Ich habe das Problem versucht in der hochgeladenen Datei zu veranschaulichen.
https://www.herber.de/bbs/user/28565.xls
Für Eure Hilfe dankt Euch jetzt schon
Urs

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Aus Zellen "unikate" Ziffern auslesen
21.11.2005 11:38:57
bst
Hi Urs,
versuch's mal so.
cu, Bernd
--
Option Explicit

Type tZiffer
   anz As Integer
   loc As Range
End Type

Sub ZiffernSuchen(src As Range, ColorIndex As Integer)
   Dim ziffern(0 To 9) As tZiffer
   Dim cell As Range, i As Integer, ch As String
   
   For Each cell In src
      For i = 1 To Len(cell.Value)
         ch = Mid(cell.Value, i, 1)
         If ch >= "0" And ch <= "9" Then
            With ziffern(CInt(Val(ch)))
               .anz = .anz + 1
               If .loc Is Nothing Then Set .loc = cell
            End With
         End If
      Next
   Next
   
   For i = 0 To 9
      If ziffern(i).anz = 1 Then
         With ziffern(i).loc.Offset(1, 0)
            .Value = i
            .Interior.ColorIndex = ColorIndex
         End With
      End If
   Next
End Sub

Sub TestIt()
   ZiffernSuchen Range("B4:L4"), 35
End Sub

Anzeige
AW: Aus Zellen "unikate" Ziffern auslesen
21.11.2005 11:45:00
Galenzo
Dim i%
For i = 0 To 9
If WorksheetFunction.CountIf(Range("b4:L4"), "*" & i & "*") = 1 Then
Cells(5, 1 + WorksheetFunction.Match("*" & i & "*", Range("b4:L4"), 0)) = i
End If
Next i
Viel Erfolg!
AW: Aus Zellen "unikate" Ziffern auslesen
21.11.2005 11:48:57
bst
Hi Galenzo,
Nett. Und schön kurz.
Gruß, Bernd
Jetzt fehlt nur noch der Einzeiler :-) Danke :-)
21.11.2005 11:59:42
urs
Hallo Galenzo
Enorm wie Du das mit einer "Telegramm-Formel" gelöst hast. Absolute Spitze.
Ich habe schon bei Bernd gestaunt, wie er das alles in so wenig Zeilen untergebracht hat und jetzt kommst Du damit.
Kunst ist eben mit Wenigem viel auszusagen!!
Ich habe noch viel zu lernen!! :-) :-)
Vielen Dank für die tolle Hilfe.
Es grüsst Urs
Anzeige
AW: Aus Zellen "unikate" Ziffern auslesen
22.11.2005 13:01:05
urs
Hallo Galenzo, hallo VBA-ler
Du hast mir gestern einen tollen Code geschickt. Ich habe leider die Anpassung für meine tatsächlich benötigten Felder nicht geschafft. Mein Versuch habe ich im untenstehenden Code festgehalten. Ich dachte, ich schaffe das ohne Hilfe.
Irgend wie bekomme ich den Zeilensprung bei Cells(.... nicht hin.
Der zu durchsuchende Bereich hängt bei mir nicht zusammen. "A2:C2" + "A4:C4" + "A6:C6"
Dim k%
For k = 1 To 9
If WorksheetFunction.CountIf(Range("A2:C2" + "A4:C4" + "A6:C6"), "*" & k & "*") = 1 Then
Cells(5, 1 + WorksheetFunction.Match("*" & k & "*", Range("A2:C2" + "A4:C4" + "A6:C6"), 0)) = k
End If
Next k
Vielen Dank für jeglichen Tip.
Gruss urs
Anzeige
AW: Aus Zellen "unikate" Ziffern auslesen
23.11.2005 09:48:04
Galenzo
die Formel .countIf funktioniert nur bei zusammenhängenden Bereichen.
AW: Aus Zellen "unikate" Ziffern auslesen
23.11.2005 10:12:18
urs
Guten Morgen Galenzo
Danke für Deinen Beitrag.
wenn ich Dich richtig verstanden habe. Muss ich mein Zellgefüge so umbauen, dass alle
Zellen in einem Block sind. Sie müssen also nicht in einer Zeile liegen. Richtig?
Also der neue Block wird lauten: Range("A2:C4")
Wie muss ich jetzt die 4. Zeile im Code mit Cells(..... gestalten?
Dim k%
For k = 1 To 9
If WorksheetFunction.CountIf(Range("A2:C4"), "*" & k & "*") = 1 Then
Cells(2, 1 + WorksheetFunction.Match("*" & k & "*", Range("A2:C4"), 0)) = k
End If
Next k
Vielen Dank für Deine Mühe
Gruss urs
Anzeige
Wow, das sieht IF-ig aus :-) Danke vorerst
21.11.2005 11:48:36
urs
Hallo Bernd
Danke für Deine spontane Reaktion und Lösung. Ich habe noch nicht alles gecheckt, aber es sieht gut aus. Werde es einsetzen und ausprobieren.
Melde mich wieder.
Gruss urs

331 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige