Cum extrag numerele dintr-un string si le pun pe fiecare separat in cate o celula

Sub Extract_Number()

Dim i, j, k As Integer
Dim TextString As String
Dim LenString As Long
Dim Result() As String
Dim Nr_Words As Long

TextString = Cells(4,1).Value
Result() = Split(TextString)
LenString = Len(TextString)

For j = 1 to Nr_Words
   If (Mid(TextString, j, 1) = " ") Then
	  Nr_Words = Nr_Words + 1
   End If
Next j

For j = 1 to Nr_Words
   For k = 0 to 9
	  If InStr(Result(j-1), k) <> 0 Then Pos = InStr(Result(j-1), k): Exit For
   Next k

Cells(4, j+1).Value = Val(Right(j-1), Len(Result(j-1)) - Pos + 1) 
Next j

End Sub

Sub Extract_Number()
Dim i, j, k, index As Integer
Dim TextString As String
Dim LenString As Long
Dim Result() As String
Dim Nr_Words As Long
TextString = Cells(4, 1).Value
Result() = Split(TextString)
LenString = Len(TextString)

index = 2
For Each xx In Split(TextString, " ")
If Val(xx) <> 0 Then
	 Cells(4, index).Value = xx
	 index = index + 1
End If

Next
End Sub

Edited by sorin147, 23 March 2019 - 23:52.

Edited by colombo2003, 24 March 2019 - 00:04.

Sub Extract_Number()
Dim index As Integer
Dim TextString As String
Dim Result() As String
Dim currentValue As String
TextString = Cells(4, 1).value
index = 2
For Each xx In Breakdown(TextString)
If IsNumeric(xx) Then
	 currentValue = currentValue + xx
Else
	 If Len(currentValue) > 0 Then
		 Cells(4, index).value = currentValue
		 index = index + 1
		 currentValue = ""
	 End If
End If
Next
If Len(currentValue) > 0 Then
Cells(4, index).value = currentValue
End If

End Sub

Private Function Breakdown(ByRef Expression As String) As String()
Dim strRet() As String, lonLen As Long
Dim l As Long
lonLen = Len(Expression)
If lonLen = 0 Then Exit Function
ReDim strRet(0 To lonLen - 1) As String
For l = 1 To lonLen
	 strRet(l - 1) = Mid$(Expression, l, 1)
Next l
Breakdown = strRet
Erase strRet
End Function

Edited by sorin147, 24 March 2019 - 00:40.

Function getIntegersAsString(ByVal source as String, ByVal token as Char) As String()
Dim data() as Char = source.ToCharArray()
Dim s1 as String = ""
For Each c as Char in data
	 if ( (c >= "0" And c <= "9") Or (c = "-") Or(c = token)) then
		 s1 += c
	 end if
Next
Dim s2() as String = s1.Split(token)
s1 = ""
For Each s as String in s2
	 if(s.Length <> 0) then
		 s1 += s + token
	 end if
Next
return s1.Split(token)
End Function

Edited by BraviaAmpero, 24 March 2019 - 06:40.

For i = 4 To 15
	TextString = Cells(i, 1).Value
	index = 2
	For Each xx In Breakdown(TextString)
	If IsNumeric(xx) Then
		 currentValue = currentValue + xx
	Else
		If Len(currentValue) > 0 Then
			Cells(i, index).Value = currentValue
			index = index + 1
			currentValue = ""
		End If
	End If
	Next
	If Len(i) > 0 Then
		Cells(i, index).Value = currentValue
		 currentValue = ""
	End If
Next

currentValue = ""

colombo2003, on 24 martie 2019 - 01:46, said:

sorin147, on 24 martie 2019 - 07:56, said:

currentValue = ""

BraviaAmpero, on 24 martie 2019 - 03:54, said:

BraviaAmpero, on 24 martie 2019 - 06:28, said:

Edited by colombo2003, 24 March 2019 - 14:46.