Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1312to1316
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

Suche eine 6-stellige Zahl

Suche eine 6-stellige Zahl
15.05.2013 22:00:26
Larissa
Hallo,
ich habe ein tolles Makro von Euch erhalten, welches in einer Spalte Namen sucht,die verbunden sind mit einem Bindestrich. Diese Namen werden jeweils in die Spalte links daneben geschrieben, bis der nächste Name gefunden wird.
Jetzt soll genau nach diesem Schema nach einer 6-Stelligen Zahl gesucht werden und diese links daneben geschrieben werden. Wie muss das folgende Makro lauten, wenn nach einer Zahl gesucht wird?
Sub NamenLinks()
'dubliziert Überschriften in eine andere Spalte
Const iColQuelle As Integer = 2   'Namen AUS Spalte 2
Const iColZiel As Integer = 1     'Namen IN Spalte 1
Const sTrenner As String = " - "  'Namen getrennt durch diese Zeichenfolge
Dim lRow As Long
Dim rBereich As Range
Dim sTempName As String
lRow = Cells(Rows.Count, iColQuelle).End(xlUp).Row
For Each rBereich In Range(Cells(1, iColQuelle), Cells(lRow, iColQuelle))
If Len(rBereich.Value) = Len(WorksheetFunction.Substitute(rBereich.Value, sTrenner, "")) _
Then
'wenn sTrenner in dieser Zelle nicht vorkommt
If Not rBereich.Value = "" Then
'Bei nichtleeren Zellen, den Namen mit Nummer nach links schreiben
Cells(rBereich.Row, iColZiel).Value = sTempName
End If
Else
'übernehme neuen Namen
sTempName = rBereich.Value
End If
Next rBereich
End Sub
Vielen Dank für Eure Hilfe,
Larissa

34
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suche eine 6-stellige Zahl
15.05.2013 22:16:45
Klaus
Hallo Larissa,
"links daneben" geht aber kaum, wenn die Namen bereits in Spalte 1 geschrieben werden. Noch Links-er gibt es nicht!
Aus dem Handgelenk die Änderungen (hab grad kein Excel zum testen, schreibe vom Netbook):
Die zu benutzenden Spalten stehen ja oben als CONST, die kannst du selber anpassen.
Sub sechsStelligeLinks()
'dubliziert Überschriften in eine andere Spalte
Const iColQuelle As Integer = 2   'Namen AUS Spalte 2
Const iColZiel As Integer = 1     'Namen IN Spalte 1
'Const sTrenner As String = " - "  'Namen getrennt durch diese Zeichenfolge
Dim lRow As Long
Dim rBereich As Range
Dim sTempName As integer
lRow = Cells(Rows.Count, iColQuelle).End(xlUp).Row
For Each rBereich In Range(Cells(1, iColQuelle), Cells(lRow, iColQuelle))
if len(rbereich.value) = 6 and isnumeric(rbereich.value) then
'wenn 6 stellige-Zahl
If Not rBereich.Value = "" Then
'Bei nichtleeren Zellen, den Namen mit Nummer nach links schreiben
Cells(rBereich.Row, iColZiel).Value = sTempName
End If
Else
'übernehme neuen Namen
sTempName = rBereich.Value
End If
Next rBereich
End Sub
Da in "sTempName" kein String mehr gespeichert wird sondern jetzt ein Integer, habe ich diese Variable umdeklariert.
Wenn Luc das sieht wird er (ganz zurecht) meckern, dass ich damit die Ungarische Notation verletzte und die Information zu Desinformation (=Warzen) wird. Wenn du ganz ordentlich bist, benennst du jede Variable "sTempName" um in "iTempZahl". Läuft aber auch so ...

Anzeige
s und i sind auch noch Warzen! ;-) Gruß owT
16.05.2013 04:29:15
Luc:-?
:-?

AW: Suche eine 6-stellige Zahl
16.05.2013 17:33:54
Larissa
Hallo Klaus,
vielen Dank für Dein Makro. Leider bleibt es an dieser Stelle stehen:
sTempName = rBereich.Value
und bringt den Laufzeitfehler 13
Weißt du, woran das liegen könnte?
Lieben Gruß,
Larissa

vielleicht so, Dim sTempName as Long -owT
16.05.2013 18:52:29
robert

AW: vielleicht so, Dim sTempName as Long -owT
16.05.2013 19:06:50
Larissa
Hallo Robert,
Leider nicht - es kommt der selbe Laufzeitfehler.
Noch eine Idee, woran es liegen könnte?
LG Larissa

AW: vielleicht so, Dim sTempName as Long -owT
16.05.2013 19:14:54
robert
Hi,
was steht denn nun in Deinen Zellen?
Nur eine Zahl oder Namen mit Bindestrich ?
Beispieldatei möglich?
Gruß
robert

AW: vielleicht so, Dim sTempName as Long -owT
16.05.2013 20:26:13
Larissa
Hallo Robert,
jetzt suche ich nach der 6-stelligen Zahl (Kundennummer)
LG Larissa

Anzeige
AW: vielleicht so, Dim sTempName as Long -owT
16.05.2013 20:18:05
Larissa
Hallo Robert,
Leider nicht - es kommt der selbe Laufzeitfehler.
Noch eine Idee, woran es liegen könnte?
LG Larissa

Oooops, sorry....
16.05.2013 20:24:04
Larissa
Sorry, diesen Kommentar habe ich versehentlich doppelt gesendet.

Sicher wohl daran, dass in der gerade ...
16.05.2013 19:09:27
Luc:-?
…verarbeiteten Zelle rBereich kein Integer-Wert steht, Larissa;
außerdem hat Klaus die Variable zwar umdeklariert, aber sonst nichts geändert (nicht mal die Kommentare!), so dass damit ein Spitzenwert an NutzerIrreführung erreicht wird.
Hätte er sTempName gar nicht spezifisch, also als Variant deklariert, würden auch F-Werte übernommen wdn. Wenn nur bestimmte Datentypen weiterverwendet wdn sollen, muss das auch im Pgm abgefangen wdn. Davon ist hier nichts zu sehen — also eher eine „Discounter-Lösung“! ;-]
Aber wir wollen ihm mal die Chance lassen, das selbst zu verbessern! ;-)
Gruß Luc :-?

Anzeige
Luc - Du Excelfuchs kennst die Lösung ;-)
16.05.2013 20:35:25
Larissa
Hallo Luc,
Danke für Deine Hinweise, nur leider komme ich Newbie damit gar nicht weiter.
Magst Du mir die Lösung verraten?
LG Larissa

AW: Luc - Du Excelfuchs kennst die Lösung ;-)
17.05.2013 09:58:31
Klaus
Hallo Luc,
mich in unserem momentanen Lieblingsthema - Notation, Kommentare und "lügender Code", hier so vorzuführen ist bestimmt dein innerer Reichsparteitag :-)
Sei dir gegönnt.
Larissa,
hier nochmal der Code mit verbesserter Deklarierung und Namensgebung. (Luc - auf die Warzen ganz verzichten werde ich nicht!):
Sub sechsStelligeLinks()
'suche 6-Stellige Kundennummer
Const iColQuelle As Integer = 2   'AUS Spalte 2
Const iColZiel As Integer = 1     'IN Spalte 1
Dim lRow As Long
Dim rBereich As Range
Dim SuchWert As Long
lRow = Cells(Rows.Count, iColQuelle).End(xlUp).Row
For Each rBereich In Range(Cells(1, iColQuelle), Cells(lRow, iColQuelle))
If Len(rBereich.Value) = 6 And IsNumeric(rBereich.Value) Then
'wenn 6 stellige-Zahl
If Not rBereich.Value = "" Then
'Bei nichtleeren Zellen, die Nummer nach links schreiben
Cells(rBereich.Row, iColZiel).Value = SuchWert
End If
Else
'übernehme neue Nummer
SuchWert = rBereich.Value
End If
Next rBereich
End Sub
Ich behaupte aber, dass dies den gleichen Fehler verursacht. Luc's Analyse (var stat integer oder long) kann nicht zutreffen, denn hier:
If Len(rBereich.Value) = 6 And IsNumeric(rBereich.Value) Then
wird ja (mit isnumeric) vorab geprüft, obs überhaupt ne Zahl ist. Allerdings könnte es einen integer-Überlauf geben, darum hab ich mal auf Long umdeklariert.
ABER: (in fett und Großschrift!)
ich wette Geld darauf, dass der Code jetzt immer noch nicht läuft. In einer deiner Zellen hat sich ein Fehler versteckt, seis ein #NA!, ein #DIV/0!, ein #REF! ..... prüfe das!
Über den Code einmal "on error resume next" drüberzubuttern damit die Fehler ignoriert werden möchte ich dir nicht raten.
Grüße,
Klaus M.vdT.

Anzeige
...Das hatte ich gemeint, wenn du mal meinen ...
17.05.2013 14:46:45
Luc:-?
…Beitrag genau liest, Klaus,
der dich natürlich nicht vorführen, sondern nur darauf aufmerksam machen sollte, welch schönes Bsp du für „lügende Warzen“ (u.Kommentare) geliefert hast! ;-)
So etwas muss ein guter PgmCode halt abfangen → Stichwort: Fehlerbehandlung! Ob das nun eine Meldung (womöglich gar mit Lokalisation!) oder ein spezieller F-Wert wird, hängt von PgmForm (Fct-/SubProc ) und -verwendungszweck ab.
Na dann mach mal! ;-)
Gruß Luc :-?

Achso, noch FroPf allerseits! ;-) owT
17.05.2013 14:48:08
Luc:-?
:-?

AW: Luc - Du Excelfuchs kennst die Lösung ;-)
17.05.2013 20:00:01
Larissa
Hallo Klaus,
Vielen Dank für die Mühe, die Du Dir mit meinem Makro machst - Trotz der Kommentare von Prof. Luc ;-)
Leider funktioniert es so noch nicht. Ich wäre Dir sehr dankbar, wenn Du Dich noch einmal daran probierst....
Lieben Gruß,
Larissa

Anzeige
immer noch Laufzeitfehler
17.05.2013 20:02:52
Larissa
Sorry - Vergessen den Beitrag offen zu halten

jetzt kommt die Datei
17.05.2013 22:19:13
Larissa
Hallo Klaus,
die Datei mit den Kundennummern ist eine exportierte Datei aus SAP.
Ich kann keine Fehler o.Ä. erkennen, aber vielleicht findest Du den Wurm, deshalb lade ich die Datei mit der entsprechenden Spalte einmal hoch....
https://www.herber.de/bbs/user/85376.xls
LG Larissa

Die war nebst der SAP-Info aber auch ...
18.05.2013 03:10:30
Luc:-?
…sehr nötig, Larissa,
denn xlVBA und SAP vertragen sich nicht so gut! Deine Datei ist jedenfalls in ihrer Funtionalität durch den SAP-Import beschädigt. Schon das Fehlen der Gitternetzlinien ist verdächtig (kenne das von QlikView, da war's genauso). Jedenfalls hat das Ganze hier zur Folge, dass das Pgm nach dem 1.geschriebenen Wert abrupt beendet wird — keine Fehlerbehandlung, keine Abfrage des ForEach-Durchlauf-Objekts auf Not Nothing hilft. Mit einer Variante hatte ich mal den Fehler Objekt fehlt, so dass ich vermute, dass der Objektbezug beim Schreiben verloren gehen könnte. Auf jeden Fall scheint SAP die XlStruktur zu beschädigen (zumindest ab Xl12, aber wohl auch bei dir). In deiner (evtl früheren) Version (wg .xls) kommt ggf ja auch ein Fehler, aber meine F-Behandlung wird gar nicht mehr erreicht. Klaus' Pgm ist also nicht schuld (abgesehen mal von der überflüssigen und falsch reagierenden Suchwert-Konstruktion).
Da aber Formeln fktionieren und ich dir nun nicht den Vorschlag machen wollte, die mit der Hand einzutragen, musste ich auf eine MatrixFml für den gesamten Zielbereich ausweichen. Die muss nämlich nur in die 1.Zelle geschrieben wdn. Anschließend kann das Pgm dann ja ruhig abbrechen — normale Fmln in jede Zelle lassen sich ebenfalls nicht per VBA eintragen → PgmZyklen (einfaches For i To n habe ich nicht getestet!) wdn noch im 1.Durchlauf abgebrochen!
Du kannst natürlich versuchen, die nackten Daten (als Werte) in eine neue Datei einzukopieren (nur neues Blatt hilft nicht!). Evtl fktioniert ja dann da eine suchwert-bereinigte Variante von Klaus' Pgm (Stichwort .Offset!) zufriedenstellend. Hier aber erst mal mein Arbeitsergebnis, das auch in deiner Originaldatei, die ich dir hier wieder hochgeladen habe, fktioniert.
Rem AutoErstellen einer MxFml in Spalte A zur Erkennung 6stelliger KundenNrn
'   in Spalte B; die Konstantt am PgmAnfang können bei Bedarf angepasst wdn.
Sub KNrExtraktFml()
Const aRow = 1, qCol As Long = 2, zCol As Long = 1
Dim eRow As Long, QBereich As Range, ZBereich As Range
On Error GoTo fx
With ActiveSheet
eRow = .Cells(.Rows.Count, qCol).End(xlUp).Row
Set QBereich = .Range(.Cells(aRow, qCol), .Cells(eRow, qCol))
Set ZBereich = .Range(.Cells(aRow, zCol), .Cells(eRow, zCol))
End With
ZBereich.FormulaArray = "=IF(ISNUMBER(--" & QBereich.Address(0, 0) & _
")*(LEN(" & QBereich.Address(0, 0) & ")=6)>0," & _
QBereich.Address(0, 0) & ","""")"
fx: If CBool(Err.Number) Then
MsgBox Err.Description, vbCritical, _
"KNrExtrakt: Fehler " & Err.Number
End If
Set QBereich = Nothing: Set ZBereich = Nothing
End Sub
Gruß + doppelt FroPf! Luc :-?

Anzeige
AW: jetzt kommt die Datei
18.05.2013 07:05:51
Klaus
Hallo Larissa,
Musterdateien wirken immer wunder. Es war eine einfacher Logikfehler - in der IF-Schleife waren "neuen Wert speichern" und "Nummer schreiben" vertauscht.
Funktioniert (bei mir) auch in der Musterdatei. Was Luc an der auszusetzen hatte konnte ich jetzt nicht nachvollziehen.

Sub sechsStelligeLinks()
'suche 6-Stellige Kundennummer
Const iColQuelle As Integer = 2   'AUS Spalte 2
Const iColZiel As Integer = 1     'IN Spalte 1
Dim lRow As Long
Dim rBereich As Range
Dim SuchWert As Long
lRow = Cells(Rows.Count, iColQuelle).End(xlUp).Row
For Each rBereich In Range(Cells(1, iColQuelle), Cells(lRow, iColQuelle))
rBereich.Select
If Len(rBereich.Value) = 6 And IsNumeric(rBereich.Value) Then
'übernehme neue Nummer
SuchWert = rBereich.Value
Else
If Not rBereich.Value = "" Then
Cells(rBereich.Row, iColZiel).Value = SuchWert
End If
End If
Next rBereich
End Sub
Grüße,
Klaus M.vdT.

Anzeige
Hammer :-)
18.05.2013 09:07:33
Larissa
Beides funktioniert SUPER!!!!
Ihr seid wahre Excelprofis und bekommt meinen allergrößten Respekt.
Ich bedanke mich 1000 Mal und wünsche auch schöne Pfingsten.
Lieben Gruß,
Larissa

Danke für die Rückmeldung! owT.
18.05.2013 11:22:05
Klaus
Ihr seid wahre Excelprofis
Dann währ das Makro aber schon beim ersten mal korrekt gelaufen! :-)

rBereich.Select war nötig ? owT
18.05.2013 11:44:54
Matthias

AW: rBereich.Select war nötig ?
19.05.2013 14:38:39
Klaus
Hi Matthias,
erwischt!
Ich seh (beim testen) gerne was der Code gerade macht, und vergess genauso gerne die .select wieder rauszunehmen :-)
Grüße,
Klaus M.vdT.

Anscheinend hat Klaus seine Gewohnheiten ...
18.05.2013 15:00:30
Luc:-?
…geändert, Larissa (& Klaus),
sonst meldet er sich idR nicht am WE. Nur deshalb hatte ich mich überhaupt damit beschäftigt.
Nun ja, hatte das unter Xl12 versucht. Vielleicht hatten dabei die anderen offenen Dateien gestört (AutoKalkModus!; da du aber auch einen Fehler hattest, habe ich das nicht weiter verfolgt) oder SAP-Export kann da mehr Schaden anrichten. Glaube nämlich kaum, das MS der Konkurrenz mehr als das unbedingt Nötige an Info zV stellt, so dass die Export-nach-Xl-Funktionalitäten mitunter doch recht fragwürdig ausfallen könnten, zumindest, wenn man dann mit einer solchen Datei mehr machen will. Hier wäre es dann sicher besser, über das DatenaustauschFormat .csv als Zwischenschritt zu gehen, denn beim Import wird Xl schon richtig vorgehen.
Bei vielen Daten dürfte die FmlLösung schneller sein. Falls es zu viele Daten für eine MxFml wdn sollten, käme auch noch eine Datenfeld-Lösung mit 1×igem Schreiben infrage (vor allem, falls die Datei wieder „spinnen“ sollte), dabei kann man auch alle KNrn in einer beliebigen Spalte oder Zeile flfd auf 1× ausgeben. Dürfte bei großen Datenmengen auch schneller sein als das DirektSchreiben Zeile-für-Zeile (bei dem der suchwert immer noch überflüssig ist, falls jede KNr nur 1× vorkommt und direkt in A der gleichen Zeile geschrieben wird — man kann dann ja auch .Offset benutzen!).
Eine Datenfeld-Lösung wollte ich ursprgl verwenden, habe das dann aber leider wg deines Wunsches, in die Nachbarzelle in A zu schreiben, sein lassen. Hätte mir sicher diverses Rätselraten wg des ZyklusAbbruchs nach dem 1.Schreiben erspart — hätte das Phänomen dann wahrscheinlich nicht mal bemerkt.
Gruß + 3×FroPf (trotz zZ Regen, auch an Klaus, Matti & Robert), Luc :-?
PS: Bitte, nicht zu überschwenglich mit dem Lob, denn das war eigentlich nur ein kleines Problem… ;-)
Der Behüt(h)er des „irrenden Fehlers“ (nach Lem) — neue (alte) Lügen, aufgedeckt von…

Anzeige
Hier dann noch die erwähnte Variante, ...
18.05.2013 16:18:57
Luc:-?
…Larissa,
zur Vollständigkeit:
Rem Erstellen einer Liste in Spalte A aus erkannten 6stelligen KundenNrn
'   in Spalte B; d.Konstantt am PgmAnfang können b.Bedarf angepasst wdn.
Sub KNrKompaktDat()
Const aRow = 1, qCol As Long = 2, zCol As Long = 1
Dim eRow As Long, fZ As Long, ixEl As Long, qBer, qZ, zBer As Variant, _
QBereich As Range, ZBereich As Range
On Error GoTo fx
With ActiveSheet
eRow = .Cells(.Rows.Count, qCol).End(xlUp).Row
Set QBereich = .Range(.Cells(aRow, qCol), .Cells(eRow, qCol))
Set ZBereich = .Cells(aRow, zCol)
End With
qBer = QBereich.Value2
For Each qZ In qBer
fZ = fZ + 1
If IsNumeric(qZ) And Len(qZ) = 6 And _
InStr(qZ, " ") = 0 And Not qZ Like "*[DdEe-]*" Then
If Not IsEmpty(zBer) Then
ixEl = ixEl + 1: ReDim Preserve zBer(ixEl)
zBer(ixEl) = qZ
Else: ReDim zBer(0): zBer(0) = qZ
End If
End If
Next qZ
If CBool(UBound(zBer)) Then
Set ZBereich = ZBereich.Resize(1 + UBound(zBer), 1)
ZBereich = WorksheetFunction.Transpose(zBer)
Else: ZBereich = zBer
End If
fx: If CBool(Err.Number) Then
MsgBox "…bei Zeile " & fZ & ":" & vbLf & Err.Description, vbCritical, _
"KNrKompaktDat: Fehler " & Err.Number & " …"
ElseIf Not IsEmpty(qZ) Then
MsgBox "…bei Zeile " & fZ & "!", vbCritical, "KNrKompaktDat: Abbruch…"
End If
Set QBereich = Nothing: Set ZBereich = Nothing
End Sub
Gruß Luc :-?

Anzeige
Hieran kann man übrigens auch sehen, ...
19.05.2013 11:58:46
Luc:-?
…wie leicht man durch eine Vorgeschichte beeinflusst wdn kann. Das wäre einerseits das Auftreten eines Fehlers, der offensichtlich anderer Natur war als bei meinen Tests, und andererseits so ein Konstrukt wie IsNumeric(…) nebst Beiwerk, das nach Verbesserung förmlich schrie! Mit dieser (unvollständigen) Verbesserung per Like-Operation wollte ich natürlich auch Nachfragen provozieren (allerdings nicht unbedingt von Tino, der hier wohl nur für die Nachwelt sein Forenwissen ausbreitet), obwohl hier ja eigentlich bereits mit If qZ Like String(6, "#") Then bzw If qZ Like "######" Then alles erledigt wäre. ;-)
Ich bin dann mal weg! FroPf, Luc :-?

Na siehst....
19.05.2013 14:38:26
Tino
Hallo,
Du kannst auch was von anderen lernen, auch wenn Du es nicht zugeben möchtest. ;-)
Like String(6, "#") = .Pattern = "^\d{6}$"
Gruß Tino

Bild dir mal nicht zu viel ein, ...
20.05.2013 03:18:24
Luc:-?
…Tino,
schließlich bist du ja nicht der Erste, der eine Dictionary-Pattern-Lösung in Foren vorstellt! Außerdem ist meine Like-VglsKonstantenLösung doch wohl etwas zu trivial für so weitgehende Vermutungen… :->
Teste im Gegenzug doch mal, was alles IsNumeric wahr macht, kannst ggf du noch was lernen… ;-]
Gruß Luc :-?

was hast Du nur mit IsNumeric?
20.05.2013 07:54:35
Tino
Hallo,
im Gegenteil zu dir kann ich offen zugeben das ich viel in diesem Forum gelernt habe.
Von Anfang an schreibst Du zu mir was von IsNumeric was in diesem Fall wie von
Anfang an von mir gezeigt nicht notwendig ist?!
Aber anstatt zu schreiben, ja stimmt oder hast recht gehst Du ja gleich wie immer in Kampfstellung.
Aber so Reaktionen bin ich von dir ja gewohnt, lohnt sich nicht drüber nachzudenken!
Gruß Tino

Mann-o-mann; IsNumeric hier zu verwenden war ...
20.05.2013 18:29:35
Luc:-?
…ja wohl offensichtlich ursprgl gar nicht meine Idee, Tino,
hatte ich doch bloß übernommen und nach meiner Erfahrung für den Fall der Fälle erweitert. Hatte ich doch wohl deutlich genug geschrieben!
Die angebliche „Kampfstellung“ beruht ebenfalls auf meiner Erfahrung, aber diesmal speziell mit dir. Habe offensichtlich sowohl was die Mitarbeit in diesem Forum als auch VBA betrifft ein paar Jahre Vorsprung vor dir. Und die wirst du wohl kaum aufholen können, da du dich in eine andere Richtung zu entwickeln scheinst. Darauf und auf deinem Bemühen, mich auf deinem Level anzusiedeln, beruht wohl letztlich der ganze Konflikt. Ich hatte dir schon mal gesagt, dass du keine Frage von mir in Foren finden wirst, was nicht heißt, dass ich nichts übernehme, was praktisch ist u/o zu meiner Spezialisierung passt. Aber viele Probleme, die hier auftauchen, hatte ich schon vor Jahren gelöst – bevor ich auch nur eine Zeile in irgendeinem Forum geschrieben habe. Und ich bin da sicher nicht der Einzige! Die andere Fraktion (wohl eine sehr deutliche Mehrheit) bilden die, die (mitunter offensichtlich) alles aus Foren haben. Dazu zählst offenbar auch du!
Übrigens ist ein schönes Bsp für frühe Überlegungen von mir diese Frage von JAck, nur hatte ich (vor 10-11 Jahren) nicht gefragt, sondern wir etwas einfallen lassen — ohne AUSWERTEN bzw Evaluate, allerdings auch ohne xlFktt, halt rein mathematisch mit einigen (auch speziellen) Operatoren. Etwas annähernd Vglbares habe ich bis heute noch in keinem xlForum gesehen…! ;-)
Bleib du ruhig bei deinen subprozeduralen „Insellösungen“, ich schreibe lieber universelle UDFs für den FmlEinsatz → das erfordert Vorausdenken und meist größere Sorgfalt u/o Umsicht!
Übrigens ist der ganze Konflikt aus der Sicht eines PgmierProfis, der mit VBA „nichts am Hut“ hat, absolut lächerlich, genauso albern wie (nicht nur aus meiner Sicht) die Verwendung von Pseudo-UN in VBA! Denn aus ProfiSicht bildet das hier mehrheitlich betriebene VBA kaum mehr als ein quasi „abgeschottetes Inselreich“ im „Programmierungsozean“, fernab von jedem Kontinent und deshalb irrelevant für ProfiLösungen! Halt nur ein Hobby! ;-)
Gruß Luc :-?

deine ausführung zeigt wieder alles! ot. u. ende
20.05.2013 19:15:56
Tino

hier eine ohne doppelte...
18.05.2013 18:48:32
Tino
Hallo,
sollte es relevant werden habe ich hier eine Variante ohne doppelte aufzulisten.
Sub FilterNummer()
Dim ArrayData, varValue
Dim RegExp, oDic

Set RegExp = CreateObject("Vbscript.Regexp")
Set oDic = CreateObject("Scripting.Dictionary")

With Tabelle1 'Quelle 
    ArrayData = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).Resize(, 2)
    Redim Preserve ArrayData(1 To Ubound(ArrayData), 1 To 1)
End With

With RegExp
    .Pattern = "^\d{6}$"
    For Each varValue In ArrayData
        If .Test(varValue) Then oDic(varValue) = 0
    Next varValue
End With

With Tabelle1 'Zieltabelle 
    .Columns(3).ClearContents 'Zielspalte alte Daten löschen 
    If oDic.Count > 0 Then
        'erste Zelle wo eingefügt werden soll 
        .Range("C1").Resize(oDic.Count) = Application.Transpose(oDic.keys)
    End If
End With
End Sub
Was Luc mit der Konstrukt alles erschlagen will ist mir schleierhaft.
... IsNumeric(qZ) And Len(qZ) = 6 And InStr(qZ, " ") = 0 And Not qZ Like "*[DdEe-]*" ...
Gruß Tino

...Sicher! Weil du offensichtlich kA hast, ...
18.05.2013 21:02:32
Luc:-?
…was alles bei IsNumericTrue ergibt! :->
Luc :-?

einer reicht ja auch mit der Ahnung oT. ;-)
19.05.2013 10:29:56
Tino

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige