23. juli 2008 - 08:09Der er
18 kommentarer og 1 løsning
Find unikt tal i tekst celle
Hej
Jeg har et problem med et find den rigtige formel som kan hjælpe. Jeg er gået helt i stå, håber der er et klogt hoved som kan hjælpe mig
Mit problem er følgende:
Jeg har flere tekstceller, hvor i der både er tal og tekst. I alle cellerne, er der et unikt 5 ciff. nummer. Som jeg er interesseret i. Celler kan også indeholde andre tal og det er forskelligt hvor i cellen det 5 ciff. nummer er noteret.
Jeg har en liste med alle de 5 ciff. numre som er unikke.
Mit ønske er at få de 5 ciff. isoleret i sin egen celle via en formel eller?
Function Udskil(adr) If InStr(adr, "12345") > 0 Then Udskil = 12345 If InStr(adr, "23456") > 0 Then Udskil = 23456 If InStr(adr, "34567") > 0 Then Udskil = 34567 If InStr(adr, "45678") > 0 Then Udskil = 45678 End Function
I arket taster du =Udskil(celle) - hvor celle er fx A1 eller andet Indsæt koden i et alm.
Den unikke liste består af ca. 10000 forskellige numre og er i en seperat liste som ligger i et ark ved siden af.
Jeg kan yderemere ikke få ovenstående funktion til at virke. Kan du udbyde den forklaring "I arket taster du =Udskil(celle) - hvor celle er fx A1 eller andet Indsæt koden i et alm."
Det jeg prøver at sige er: Jeg har en liste på 10000 unikke numre og den skal gerne tjekke op mod denne liste. Hvis et af de unikke numere er repræsenteret i tekstcellen skal den gerne fremkomme i celle vedsiden af.
Du har faktisk hjulpt et langt stykke på vejen, men jeg mangler stadig at lage tjekket opmod denne liste. Er det noget du kan hjælpe med?
prøv denne, det er muligt den kører lidt sløvt, det er mange celler der skal testes
Function Udskil(adr) Application.Volatile Set sh = Sheets("agentkode") For t = 1 To 50000 If InStr(adr, sh.Cells(t, 1)) > 0 Then Udskil = sh.Cells(t, 1): Exit For Next If Udskil = "" Then For t = 1 To 50000 If InStr(adr, sh.Cells(t, 2)) > 0 Then Udskil = sh.Cells(t, 2): Exit For Next End If End Function
Når du har valgt Module i insert menuen, fremkommer et vindue som hedder Projektmappenavn - Module1(code) Det er her koden skal indsættes Så taster du ALT+F11 igen for at vende tilbage til Excelarket Her indsætter du i cellen til højre for den første celle med blandet værdier : =udskil(celle) Så kan du trække ned i fyldhåndtaget så langt som du har data med blandet værdier
Set sh = Sheets("Ark2") rk = sh.Cells(5000, "A").End(xlUp).Row sh.Range("P1:P3000") = ""
For t = 1 To rk x = "*" & Cells(t, 1) For v = 2 To Len(x) - 4 If Not IsNumeric(Mid(x, v - 1, 1)) And Not IsNumeric(Mid(x, v + 5, 1)) Then y = Trim(Mid(x, v, 5)) y = Application.WorksheetFunction.Substitute(y, ".", "") y = Application.WorksheetFunction.Substitute(y, ",", "") y = Application.WorksheetFunction.Substitute(y, ":", "") y = Application.WorksheetFunction.Substitute(y, "-", "") If Len(y) = 5 And IsNumeric(y) And y > 0 And y < 100001 Then Cells(t, "P") = y End If Next Next
End Sub
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
