Jump to content

SUBIECTE NOI
« 1 / 5 »
RSS
Info Coronavirus/Vaccinare vs Fake News

Plafoniera led cu backlight

Am pierdut contractul de munca, a...

Certificat TVA pentru Auto SH de ...
 Sectorul 4 ridica masini abuziv?

N-are vlaga in a 5 a

Motorul se supraincalzeste?

Monitor max 24 inci , programare...
 avarie usoara

KIA XCEED PE 1.5 T-GDi Hybrid Ele...

Rotoare, statoare și alte ge...

Achizitie logan nou (ce cutie, ce...
 La multi ani @micutu82!

Olivia Newton-John va ramane prin...

Refuz comanda rapida ?!

Certion - proiecte la mare ș...
 

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

- - - - -
  • Please log in to reply
15 replies to this topic

#1
colombo2003

colombo2003

    Senior Member

  • Grup: Senior Members
  • Posts: 6,310
  • Înscris: 16.07.2008
Am o problema cu care ma chinui de ceva vreme si nu reusesc sa ii idau de cap.
In celula A4 sa zicem, am un string care contine si numere. Vreau sa extrag fiecare numar (nu fiecare cifra dintr-un numar) si sa il pun in cate o celula.
Tot ce am incercat, nu a dat rezultatul scontat.

Exemplu: in A4 am striungul "Randurile 605 608 si 616"
Doresc ca in B4 sa pun 605, in C4 sa am 608 si in D4 sa fie 616.


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


Ce anume e gresit? Cum as putea face correct?

Multumesc

#2
sorin147

sorin147

    Senior Member

  • Grup: Senior Members
  • Posts: 5,056
  • Înscris: 11.08.2003
prima buba: Nr_Words e definit dar nu are atribuita nici o valoare => nici un for nu se va executa

#3
colombo2003

colombo2003

    Senior Member

  • Grup: Senior Members
  • Posts: 6,310
  • Înscris: 16.07.2008
Merci, mea culpa!
E pe laptopul de la job si nu am putut sa copies codul correct, asa ca l-am scris, si, din viteza, am scris gresit:
- Nr_Words este initializat. linia asta Nr_Words = 0 este deasupra lui TextString = Cells(4,1).Value\
- priml For merge pana la LenString si nu pana la Nr_Words.

Deci pare correct, si totusi nu face ce si cum trebuie. Deci?

PS. Incerc sa editez.

#4
sorin147

sorin147

    Senior Member

  • Grup: Senior Members
  • Posts: 5,056
  • Înscris: 11.08.2003
daca Nr_Words = 0 atunci  
For j = 1 to Nr_Words
n-ar trebui sa se execute (cred, VB noob :) ).

#5
colombo2003

colombo2003

    Senior Member

  • Grup: Senior Members
  • Posts: 6,310
  • Înscris: 16.07.2008
Nu am mai putut corecta si primul post.

Dupa cum am zis, primul for merge de la 1 la Lengstring, si l-am gandit ca, parcurngandu-mi tot sirul, sa-mi determine nr de cuvinte.
Asadar al doilea for (care merge de la 1 la nr de cuvinte) se executa, numai ca in final nu obtin ceea ce vreau.
Imi scrie 0 daca in cuvantul respective nu sunt cifre sau numere (asta e o alta problema, nu ma deranjeaza asa de tare sau de mult si eventual am sa o vad dupa; imporntanta este partea asta cu separarea sa mearga bine) si doar ultima cifra sau ultimele doua cifre din fiecare numar (in loc de tot numarul).

PS. Si eu sunt noob in VBA...

#6
sorin147

sorin147

    Senior Member

  • Grup: Senior Members
  • Posts: 5,056
  • Înscris: 11.08.2003
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


-index: va tine minte locatia pentru noile celule cu numere
- Split(TextString, " ") - imparte textul dupa " " (<- spatiu) astfel incat vei avea un array cu 5 elemente (in acest caz)
- For Each xx In Split(TextString, " ") - trece prin fiecare element din impartire (split). Fiecare element este stocat in xx
- Val(xx) - transforma elementul xx in numar (cel putin incearca)

La mine merge. Posted Image

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


#7
colombo2003

colombo2003

    Senior Member

  • Grup: Senior Members
  • Posts: 6,310
  • Înscris: 16.07.2008
Sorry, nu vazusem ca ai postat, cand am adaugat acest post.
Functioneaza bine! Merci. Cat de simplu era...

Insa ar trebui sa mearga si pentru un string de genul "Poarta-31 si zonele 10 si 20". Adica sa imi extraga pe 31 din cuvant.Ceea ce solutia de mai sus nu face.
Ma mai chinui, tot mai incerc, poate o adaptez si reusesc si pentru varianta asta... Insa orice ajutor si solutie e binevenit(a).

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


#8
sorin147

sorin147

    Senior Member

  • Grup: Senior Members
  • Posts: 5,056
  • Înscris: 11.08.2003
pentru -31 nu merge.
In acest caz, logica ar cam fi:
- imparte textul in array de caractere (split simplu)
- treci prin fiecare caracter -> folosesti functia val() sa vezi daca e cifra => daca e, o stochezi intr-o variabila (text) numar_curent (sau cum vrei sa-l denumesti). => mergi la urmatorul caracter => daca e tot numar, atunci il adaugi la numar_curent => daca nu e numar, atunci aplici val(numar_curent) => treci numarul avut in celula corespunzatoare => resetezi numar_curent la "" => adaugi +1 la indexul care tine de celule (ca sa scrie in urmatoarea celula) => si tot asa pana la sfarsit
(sper ca n-am uitat nimic)

#9
sorin147

sorin147

    Senior Member

  • Grup: Senior Members
  • Posts: 5,056
  • Înscris: 11.08.2003
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


- mai ai o noua functie care sparge textul in caractere
- trece prin fiecare caracter => daca gaseste unul, il pune la currentvalue => cand nu mai gaseste, aca exista un currentvalue atunci pune numarul in celula, adauga +1 la index si sterge currentvalue
- la sfarsit, daca mai exista un currentvalue care e mai lung de 0 caractere (len(currentvalue)) atunci mai e un numar de pus (cazul tau)

PS: aparent exista o functie care verifica daca un caracter e cifra sau nu, respectiv IsNumeric(xx)

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


#10
colombo2003

colombo2003

    Senior Member

  • Grup: Senior Members
  • Posts: 6,310
  • Înscris: 16.07.2008
Wow cat de rapid esti! Am inteles logica, dar cam greu de "digerat"... Aici la parcurgerea caracterelor fiecarui sir ma tot gandeam cum sa fac si nu prea imi era evident.
Functioneaza perfect! Multumesc pentru timpul acordat si ajutor. Raman dator Posted Image


PS. Rezolvat. Se poate inchide! Multumesc

#11
colombo2003

colombo2003

    Senior Member

  • Grup: Senior Members
  • Posts: 6,310
  • Înscris: 16.07.2008
Inca nu va rog...

Ce am discutat este pentru un singur string de pe un singur rand (celula A4), insa in realitate eu am mai multe (15) astfel de siruri, pe coloana A, de la A4 al A18.

Am bagat continutul intr-un for (de la 1 la 15 sau cate linii voi avea) si merge, numai ca se intampla acum urmatorul fenomen: imi ia ultimul numar de la primul sir pus in casuta lui si mi-l pune primul pe randul urmator (in zona unde se stocheaza numerele) si dupa, in casutele urmatoare, numerele din sirul de pe randul al doilea (de la A5). Si tot asa pana la sfarsit: ultimul numar precedent devine primul pentru sirul urmator. Incerc sa vad unde e problema si sa o fixez, dar e posibil sa nu mai pot la ora asta...

#12
BraviaAmpero

BraviaAmpero

    Member

  • Grup: Members
  • Posts: 923
  • Înscris: 03.11.2018
Nici o problema, uite este 3:46 iar am chef de programare.
So, ca sa inteleg eu mai bine: ai de procesat niste valori dintr-o foaie de Excel in VBA, si  de exemplu doar pt celula  A4 ai stringul "Randurile 605 608 si 616"
si doreste ca in B4 sa pui 605, in C4 sa am 608 si in D4 sa fie 616.

iar daca ai un interval de celule A4 -> A30 , atunci pt celule de la  B4->B30 va fi primul numar extras, pt celulele C4->C30 vrei al doilea numar extras si pt celule D4-> D30 vrei al treilea numar extras ?

#13
BraviaAmpero

BraviaAmpero

    Member

  • Grup: Members
  • Posts: 923
  • Înscris: 03.11.2018
Hello am revenit cu noutati:
mai  jos ai un exemplu de extragere corecta a numerelor negative/pozitive dintr-un string:

Ce te intereseaza pe tine este functia:
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

O poti vedea in actiune aici: https://dotnetfiddle.net/BI1ATf
PS:Habar n-am de Visual Basic dar asta nu ma impiedica sa scriu cod in VB .Net (easy as cake btw )

In VB .Net nu am gasit un regex pattern care sa-ti extraga si numere negative.Sunt regex pattern care extrag doar numere pozitive, insa negative eu nu am gasit  iar cele care in alte limbaje fac extragere si de numere negative in VB .Net nu merg si atunci
ti-am creat functia asta care extrage  separat toate integer-urile dintr-un string.

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


#14
sorin147

sorin147

    Senior Member

  • Grup: Senior Members
  • Posts: 5,056
  • Înscris: 11.08.2003
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


mai era nevoie de asta dupa ultima valoare gasita, ca sa fie totul resetat inaintea unui nou rand
currentValue = ""


#15
colombo2003

colombo2003

    Senior Member

  • Grup: Senior Members
  • Posts: 6,310
  • Înscris: 16.07.2008

View Postcolombo2003, on 24 martie 2019 - 01:46, said:

...
numai ca se intampla acum urmatorul fenomen: imi ia ultimul numar de la primul sir pus in casuta lui si mi-l pune primul pe randul urmator (in zona unde se stocheaza numerele) si dupa, in casutele urmatoare, numerele din sirul de pe randul al doilea (de la A5). Si tot asa pana la sfarsit: ultimul numar precedent devine primul pentru sirul urmator

View Postsorin147, on 24 martie 2019 - 07:56, said:

...
mai era nevoie de asta dupa ultima valoare gasita, ca sa fie totul resetat inaintea unui nou rand
currentValue = ""
Da boss, merci.
Gasisem si eu solutia asta pana la urma, insa nu am mai avut putere sa o postez. Era vreo 3 jumate cand m-am culcat.

View PostBraviaAmpero, on 24 martie 2019 - 03:54, said:

...
iar daca ai un interval de celule A4 -> A30 , atunci pt celule de la  B4->B30 va fi primul numar extras, pt celulele C4->C30 vrei al doilea numar extras si pt celule D4-> D30 vrei al treilea numar extras ?
Da.

View PostBraviaAmpero, on 24 martie 2019 - 06:28, said:

Multumesc si tie pentru solutia oferita si timpul acordat. Posted Image

----------------------------------------------------------------------------

In alta ordine de idei, m-am gandit si am mai schimbat si am adus niste modificari (pe care am reusit sa le fac si functioneaza; am revin si cu cod):
- extragerea numerelor sa nu mai fie aceeasi linie (B4, C4, D4 etc), ci sa le puna unele sub altele, pe aceesi coloana unde sunt stringurile (cu o linie goala intre)
-  se va selecta apoi toata zona de numere extrase si se vor elimina duplicatele
- apoi, lista ramasa va fi sortata crescator
- apoi, la fiecare nr din lista, se va adauga un prefix (un string) (acelasi la toate; exemplu "NR-")

Partea nasoala e (nestiind cum sa fac), am doua sheeturi: unul in care imi aduc lista de stringuri initiala (sa ii zicem lista 1; si care va proveni prin paste din alt fisier txt) si altul in care imi fac aceste aranjamente si extractii. La final, trebuie sa aduc lista fara dubloane (sa ii zicem lista 2), ordinata crescator, la care aplic prefixul, in celalalt sheet.

In primul sheet, dau paste la lista 1, apas un buton (care are in spate tot codul) si imi genereaza (copiaza) lista 2.

Problema e ca daca mai apas inca o data butonul din sheet 1 (dupa ce mi-a generat o data lista 2), imi crapa.
Daca in cod bag ca la activare sheet 1 sa sterg bucatarie din sheet 2, lista 2 din sheet 1 nu o sa mai aibre referinte.
Mai sap, mai sap.

Multumesc tuturor pentru ajutor

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


#16
colombo2003

colombo2003

    Senior Member

  • Grup: Senior Members
  • Posts: 6,310
  • Înscris: 16.07.2008
Eroarea pe care o obtin daca incerc sa rulez inca o data (fara sa sterg rezultatele anterioare) este o eroare de executie, cod 92: bucla for ne initializata.

Anunturi

Chirurgia cranio-cerebrală minim invazivă Chirurgia cranio-cerebrală minim invazivă

Tehnicile minim invazive impun utilizarea unei tehnologii ultramoderne.

Endoscoapele operatorii de diverse tipuri, microscopul operator dedicat, neuronavigația, neuroelectrofiziologia, tehnicile avansate de anestezie, chirurgia cu pacientul treaz reprezintă armamentarium fără de care neurochirurgia prin "gaura cheii" nu ar fi posibilă. Folosind tehnicile de mai sus, tratăm un spectru larg de patologii cranio-cerebrale.

www.neurohope.ro

0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users

Forumul Softpedia foloseste "cookies" pentru a imbunatati experienta utilizatorilor Accept
Pentru detalii si optiuni legate de cookies si datele personale, consultati Politica de utilizare cookies si Politica de confidentialitate