Sternchen setzen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub stars() Dim rng As Range, lngPos As Long For Each rng In Selection.Cells If Len(rng) Then For lngPos = 1 To Len(rng) If IsNumeric(Mid(rng, lngPos, 1)) Then rng.Offset(0, 1) = Left(rng, lngPos - 1) & "*" & Mid(rng, lngPos) Exit For End If Next End If Next End Sub

Hallo Sepp,
ich benötige eine Erweiterung, in der Hoffnung, dass Du mir helfen kannst.
Ich habe Dein Makro etwas angepasst.

Sub Sternchen()
Dim rng As Range, lngPos As Long
Dim Bereich As Range
Set Bereich = ActiveSheet.Range("F5:F17")
For Each rng In Bereich
If Len(rng) Then
For lngPos = 1 To Len(rng)
If IsNumeric(Mid(rng, lngPos, 1)) Then
rng.Offset(0, 0) = Left(rng, lngPos - 1) & "*" & Mid(rng, lngPos)
Exit For
End If
Next
End If
Next
End Sub

Neben der Plausi in Deinem Makro soll das Sternchen nur dann gesetzt werden, wenn der jeweilige Wert aus F5, F6, etc. nicht in einer anderen Tabelle (Test Spalte A) hinterlegt ist. Jeder Wert muss einzeln geprüft werden. Also F5 kann also ggf. nicht mit einem Sternchen versehen werden, während F6 nicht, weil dieser Wert in der Tabelle vorkommt.
Kannst Du mir hier was basteln oder brauchst Du eine Beispieldatei?
Vielen Dank!
Liebe Grüße
Claudia

Sub Sternchen() Dim rng As Range, lngPos As Long Dim Bereich As Range Set Bereich = ActiveSheet.Range("F5:F17") For Each rng In Bereich If Len(rng) Then If IsError(Application.Match(rng, Sheets("Test").Columns(1), 0)) Then For lngPos = 1 To Len(rng) If IsNumeric(Mid(rng, lngPos, 1)) Then rng.Offset(0, 0) = Left(rng, lngPos - 1) & "*" & Mid(rng, lngPos) Exit For End If Next End If End If Next Set Bereich = Nothing End Sub

Hallo Sepp,
kannst Du mir vielleicht eine Änderung einbauen. Bislang ist es ja so, dass der Bereich F5:F17 geprüft wird - jeder Wert einzeln für sich. Wenn der Wert nicht in einer anderen Tabelle (=Test / Spalte A) enhalten ist, soll zwischen Buchstabe und Zahl ein Sternchen gesetzt werden.
Aufgrund der zahlreichen Besonderheiten habe ich festgestellt, dass die Lösung nicht immer klappt (liegt aber nicht an dem Makro, sondern an den Besonderheiten).
Kannst Du es so einrichten, dass jeder Wert aus F5:F17gegen die Tabelle Test geprüft wird. Wenn der Wert in Spalte A gefunden wird, dann soll zurückkommen, der Wert aus Spalte B der gleichen Zeile. Die Korrektur erfolgt auch in F5:F17. Wenn er nicht vorhanden ist, soll nix passieren (also kein Fehlerhinweis oder ähnliches).
Kannst Du hier was machen?
Liebe Grüße
Claudia

Sub ohneSternchen() Dim rng As Range, Bereich As Range Dim vntRet As Variant Set Bereich = ActiveSheet.Range("F5:F17") For Each rng In Bereich If Len(rng) Then vntRet = Application.Match(rng, Sheets("Test").Columns(1), 0) If IsNumeric(vntRet) Then rng = Sheets("Test").Cells(vntRet, 2) End If End If Next Set Bereich = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread