Schleife erstellen / Zahlen finden
25.01.2004 22:07:44
Erich M.
ich bastle schon den ganzen Tag an einem Code, als Fortsetzung von:
https://www.herber.de/forum/archiv/368to372/t370039.htm
Der Vorschlag von K.Rola ist super und ich möchte den nun sukzessive ausbauen.
Es geht darum, dass aus einer Zelle (A2), die Buchstaben und Zahlen enthält,
die Zahlen ausgelesen werden und in P2 und Q2 übertragen werden sollen.
Das funktioniert bereits. Nun möchte ich erreichen, dass dies analog auch
für die Zellen A3 bis A10 erfolgt - hier ist das Problem. Wenn ich einzeln
den Code für jede Zelle schreibe geht es, aber ich kriege die Schleife nicht hin.
Siehe diese Varianten:
Option Explicit
Sub Zahlen_aus_Text1()
Dim r As Range, intSpalte As Integer, i As Long
Dim n As String
' Eintrag aus Celle A2
Worksheets("Tabelle1").Cells(2, 1).Select
Set r = ActiveCell
intSpalte = r.Column + 14
On Error Resume Next
For i = 1 To Len(r.Text)
If IsNumeric(Mid(r.Text, i, 1)) Then
r.Offset(0, intSpalte) = r.Offset(0, intSpalte) & Mid(r.Text, i, 1)
Else
If Len(r.Offset(0, intSpalte)) > 0 Then intSpalte = intSpalte + 1
End If
Next
' Eintrag aus Celle A3
Worksheets("Tabelle1").Cells(3, 1).Select
Set r = ActiveCell
intSpalte = r.Column + 14
On Error Resume Next
For i = 1 To Len(r.Text)
If IsNumeric(Mid(r.Text, i, 1)) Then
r.Offset(0, intSpalte) = r.Offset(0, intSpalte) & Mid(r.Text, i, 1)
Else
If Len(r.Offset(0, intSpalte)) > 0 Then intSpalte = intSpalte + 1
End If
Next
End Sub
Sub Zahlen_aus_Text()
' übertragen von Zahlen aus Spalte A in Spalten P und Q
Dim intSpalte As Integer, i As Long
Dim r As Range
Dim n As Integer
'Set r = Cells(ActiveCell, ActiveCell.Offset(10, 0))
'Set r = Cells(2, 1)
'For r = 2 To 10
n = Cells(2, 1).Select
Set r = ActiveCell
For n = 0 To 9 'Zeilen nach unten werden angesprochen
'Set r = Cells(ActiveCell, ActiveCell.Offset(10, 0))
intSpalte = r.Column + 14
On Error Resume Next
For i = 1 To Len(r.Text)
If IsNumeric(Mid(r.Text, i, 1)) Then
r.Offset(n, intSpalte) = r.Offset(n, intSpalte) & Mid(r.Text, i, 1)
Else
If Len(r.Offset(n, intSpalte)) > 0 Then intSpalte = intSpalte + 1
End If
Next
Next n
'Next r
End Sub
Code eingefügt mit: Excel Code Jeanie
Besten Dank für einen Tipp, wie ich beim unteren Besispiel die Schleife
hinbekommen kann.
mfg
Erich