04. september 2017 - 18:28Der er
79 kommentarer og 1 løsning
Find og fjern resterende tekst/tal
Hej Eksperten
Jeg har en liste med nogle varer, hvor jeg ud fra dem også får størrelsen på dem. F.eks. Chokolade 7X150 G, eller Chokolade 10 X 1 KG. (står i C10 og ned, hvis det kan hjælpe).
Det jeg skal bruge er data før X, så nogen gange er der mellemrum mellem antal og X andre gange står det helt op af. Jeg har søgt og afprøvet diverse formler, men uden held. Er der nogen, som er lidt skarpere i det end jeg og kan en løsning - så vil det hjælpe mig helt vildt.
Hvis der max er 3 cifre i antal: =hvis(er.tal(midt(erstat(c10;" ";"");FIND("X";C10)-3;3));midt(erstat(c10;" ";"");FIND("X";C10)-3;3));hvis(er.tal(midt(erstat(c10;" ";"");FIND("X";C10)-2;2));midt(erstat(c10;" ";"");FIND("X";C10)-2;2));midt(erstat(c10;" ";"");FIND("X";C10)-1;1))
#4 Nu får jeg følgende fejl: Du har indtastet for få argumenter for denne funktion. erstat(c10;" ";"")
#7 Dit resultat er egentlig ok, men problemet er bare hvis den hedder K1tk3t, så giver den et forkert resultat. Derfor den blot skal tage det som står før X.
#10 Dit resultat giver faktisk næsten det som jeg skal bruge, dog er skriver den hele med. Altså Chokolade 14 i stedet for blot 14.
Som kigger om der er % i først, men ny udfordring er så kommet. Nogen steder hvis der f.eks. står Marabou 70 5x200G så skriver den stadig 70, hvis jeg så fjerner 70 så skriver den rigtigt nok 5.
Skal siges, jeg henter et varekartotek ned på mange tusind linjer, derfor ville det være en hjælp at det var automatiseret. Da antal i kolli står i varetekst.
Håber det sidste kan lade sig gøre, foreløbig tak for hjælpen!!
For eksempel denne. Den sætter tallet ind i kolonne D:
Sub FindTal() Dim x, y, z, S, LastRow As Integer LastRow = Range("C65536").End(xlUp).Row For x = 10 To LastRow Cells(x, 4).ClearContents On Error Resume Next y = WorksheetFunction.Search("x", Cells(x, 3)) S = 0 For z = y - 1 To 1 Step -1 If IsNumeric(Mid(Cells(x, 3), z, 1)) Then S = 1 Cells(x, 4) = Mid(Cells(x, 3), z, 1) & Cells(x, 4) Else If S = 1 Then GoTo A: End If End If Next A: Next End Sub
[div] Option Explicit Dim MySplit() As String Dim iCount As Integer Function Find_Tal(Celle As Range) As String Application.Volatile MySplit() = Split(Celle.Value, " ") For iCount = LBound(MySplit) To UBound(MySplit) If UCase(MySplit(iCount)) Like "*X*" Then Find_Tal = Left(MySplit(iCount), InStr(1, UCase(MySplit(iCount)), "X") - 1) End If Next End Function [/Div]
#22 Det virker super godt, kan du gøre sådan, at den kun tager tallet? Har nogen steder, hvor der stod Lindt20x100G, så skriver den Lindt20, ville være fedt med kun tallet - hvis det kan laves i UDF.
Har du mukighed for at rense din liste og opdele den i 2 kolonner? Er der i listen mere end et X (som gange tegn) i listen?
1. Udskift x med X 2. Opdel i 2 kolonner (ved gange tegn) 3. Fjern over flødige blanke 4. Indsæt UDF (Makro)
1.
Sub Ud_skift_x_med_X() ' Selection.Replace What:="x", Replacement:="X", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False End Sub
2.
Sub Del_i_2_kolonner_ved_X() ' Dim myRange As Range Set myRange = Selection ' myRange.TextToColumns Destination:=myRange, DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :="X", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True End Sub
3.
Sub Fjern_overflødige_blanke() Dim r As Range
With Application.WorksheetFunction For Each r In Intersect(Selection, ActiveSheet.UsedRange) r.Value = .Trim(r.Value) Next r End With End Sub
4.
Public Function SøgBagfra(I_tekst As String, Søg_efter As String) As Integer SøgBagfra = InStrRev(I_tekst, Søg_efter) End Function
[div] Function Find_Tal(Celle As Range) As Long Application.Volatile MySplit() = Split(Celle.Value, " ") For iCount = LBound(MySplit) To UBound(MySplit) If UCase(MySplit(iCount)) Like "*X*" Then sString = Left(MySplit(iCount), InStr(1, UCase(MySplit(iCount)), "X") - 1) If IsNumeric(sString) Then Find_Tal = sString Else For iA = 1 To Len(sString) If IsNumeric(Mid(sString, iA, 1)) Then Find_Tal = Find_Tal & Mid(sString, iA, 1) Next End If End If Next Find_Tal = Find_Tal * 1 End Function
Option Explicit Dim lCount As Long Dim sString As String Dim bTal As Boolean Function Find_Tal(Celle As Range) As Long Application.Volatile bTal = False sString = "" For lCount = 1 To Len(Celle.Value) If bTal = True Then Find_Tal = sString If Mid(UCase(Celle.Value), lCount, 1) = "X" Then Exit For If IsNumeric(Mid(Celle.Value, lCount, 1)) Or Mid(Celle.Value, lCount, 1) = 0 Then bTal = True Else bTal = False sString = "" End If If bTal = True Then sString = sString & Mid(Celle.Value, lCount, 1) Next Find_Tal = Find_Tal * 1 End Function
Option Explicit Dim lCount As Long Dim sString As String Dim bTal As Boolean Function Find_Tal(Celle As Range) As Long Application.Volatile bTal = False sString = "" For lCount = 1 To Len(Celle.Value) If bTal = True Then Find_Tal = sString If Mid(UCase(Celle.Value), lCount, 1) = "X" Then If UCase(Mid(Celle.Value, lCount - 2, 3)) = "BOX" Or UCase(Mid(Celle.Value, lCount - 2, 3)) = "MIX" Or UCase(Mid(Celle.Value, lCount, 2)) = "XL" Then Else Exit For End If End If If IsNumeric(Mid(Celle.Value, lCount, 1)) Or Mid(Celle.Value, lCount, 1) = 0 Then bTal = True Else bTal = False sString = "" End If If bTal = True Then sString = sString & Mid(Celle.Value, lCount, 1) Next Find_Tal = Find_Tal * 1 End Function
Kan man ud fra din kode, gøre så det er man ikke skal bruge =Find_tal(C2); at den blot tager noget ud ala: "Intersect([D2:D25], Target)"
Således, at den stadig skal finde data fra C2 og ned til C:25 men skal skrive i D2 til D25 (like Find_tal(C2);)
Det er blot fordi, hvis jeg ikke har antal i kolli nu, skriver den rigtigt nok 0. Men hvis lige manuelt skriver 3, så er den formel ødelagt. Så det var mere, om man kunne noget tilsvarende uden at ødelægge formlen.
Hvorfor ligger du ikke bare en ekstra kolonne ind og skriver Find_Tal(A1 & B1) ? I B skriver du så bare 3X ellers må du nok over i noget macro hvor facit skrives direkte i cellen.
Sub mFind_Tal() const StartCelle as String="A1" const SlutCelle as String="A10" Dim rArea as Range Set rArea=ActiveSheet.Range(StartCelle,SlutCelle) Dim rCell as Range For each rCell in rArea rCell.offset(0,2).Value=Find_Tal(rCell) Next End Sub
Beklager det sene svar, har haft travlt med al mulig andet end excel. Tror ikke helt, at det var det jeg mente.
Det som MACRO skulle gøre, at jeg ikke skal bruge en formel, den skal blot selv skrive indholdet fra C2:C25 over i D2:D25 uden at skulle ødelægge =Find_tal(C2).
Så tænkte jeg på, om i stedet for om den skriver 0 - hvis der ikke er angivet kolli om den kan forblive blank?
Det er også den jeg bruger nu, men det er for at formlen ikke bliver ødelagt.
Jeg tænkte om man ikke kunne, lave en MACRO på selve cellerne. Så hvis den er blank kan man stadig skrive i den UDEN formlen faktisk bliver ødelagt. Giver det mening?
Makro skal skrives på engelsk også formlen (IF og , i stedet for ;):
Sub Indsætformel() For Each rcell In Range("D2", "D22") rcell.Formula = "=IF(Find_tal(C" & rcell.Row & ")=0,"""", Find_tal(C" & rcell.Row & "))" Next End Sub
Denne her under vil kunne bruges i en dansk version af Excel
Sub Indsætformel() For Each rcell In Range("D2", "D22") rcell.FormulaLocal = "=Hvis(Find_tal(C" & rcell.Row & ")=0;""""; Find_tal(C" & rcell.Row & "))" Next End Sub
Tak for forsøget. Umiddelbart ser det jo godt ud, den har rettet i formlerne. Men den retter den ikke tilbage igen automatisk, efter C2 er slettet igen. Er der mulighed for det?
Ellers skal jeg lave en knap som en 'reset', problemet er bare, jeg ved ikke hvordan jeg skal få alle formler retur. For har flere blandt andet med LOPSLAG osv.
Ved denne reset, kunne den også slette alt i en celle, så det blev helt som ny og alle formler kom retur igen. Ville det ikke være en bedre løsning? For det ser ikke ud til, at det kan komme til at køre automatisk.
Jeg fik en idé, men ved ikke - om det kan føres ud og/eller tager for mange kræfter for Excel.
Jeg har søgt på nettet og har set, man kan lave en auto refresh. Hvilket man også kunne bruge, således - at man tjekker f.eks. A2:A25 igennem om cellen er blank. Hvis den er det og formlen ikke er ødelagt, skal den ikke gøre noget. Men er den blevet ødelagt, fordi man selv har måttet skrive antal på - og cellen så bliver blank igen skal auto refresh køre formlen igennem igen.
Altså, den skal kun tjekke om cellen er blank, hvis den er blank og den ingen formel har - så skal den tilføjes igen. Giver dette bedre mening i forhold til det andet?
Med denne kan du klikke på det blanke felt og koden kommer over!!
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("D2:D22")) Is Nothing Then On Error GoTo MyEnd If Target = "" Then Target.Formula = "=IF(Find_tal(C" & Target.Row & ")=0,"""", Find_tal(C" & Target.Row & "))" End If End If MyEnd: End Sub
Jeg tror vi snakker forbi hinanden, for den skal tilføje formlen igen hvis den ikke er der. Dog ville det nok være mere praktisk, at den tjekker om der står noget i C2:C25 og hvis der står noget og D2:D25 er blanke så skal den tilføje formlen igen.
F.eks. Jeg skriver i C2 en vare, som mangler antal (2x200g), i D2 skriver den intet da den i forvejen skriver 0 og med =HVIS fjerner den '0'. Her skulle man bare selv skrive noget i D2 og når C2 bliver slettet igen, skriver den formlen på D2 igen (hvis den vel og mærket mangler).
Håber dette giver bedre mening, beklager ellers - for det er nogle super forsøg du kommer med. Sætter virkelig stor pris på dit arbejde!
Højreklik på Arkfanen of vælg "Vis programkode" Indsæt følgende kode
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("C2:C22")) Is Nothing Then If Target = "" Then Target.Formula = "=IF(Find_tal(C" & Target.Row & ")=0,"""", Find_tal(C" & Target.Row & "))" End If End If End Sub
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("C2:C22")) Is Nothing Then If Target = "" Then Target.Offset(0, 1).Formula = "=IF(Find_tal(C" & Target.Row & ")=0,"""", Find_tal(C" & Target.Row & "))" End If End If End Sub
Fedt fedt, hvordan finder jeg ud af at tilpasse den, således hvis cellen bliver flyttet til B i stedet for C i dit forslag? Og kan man tilføje flere formler i andre celler, samme case som før. F.eks. Hvis B2 er blank og stiller på den, at den tjekker C2, D2, E2 osv. og mangler nogle en formel - så bliver den tilskrevet?
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("C2:C22")) Is Nothing Then on error goto MyEnd If Target.value = "" Then on error goto MyEnd Target.Offset(0, 1).Formula = "=IF(Find_tal(C" & Target.Row & ")=0,"""", Find_tal(C" & Target.Row & "))" End If End If on error goto 0 MyEnd : End Sub
#Nervatos Læg altid hele koden. Så er det nemmere at se hvad du laver?
"Denne skulle skrives fra B hen til G......." Target.Offset(0, 5).Formula = "=HVIS.FEJL(C" & Target.Row & "*D" & Target.Row & "*F" & Target.Row & ";"""")"
Target.Offset(0,5).Formula er cellen fem step til højre for Target-Cellen
Bruger du: For Each rcell In Range("D2", "D22") vil den skrive fra række 2 til 22
Har prøvet at smide " foran C men uden held, får følgende fejl med den: Compile error: Expected: end of statement
Og uden " foran C: Run-time error '1004': Application-defined or object-defined error
Skal siges, at jeg har programmet på dansk og da det skulle køre på en anden PC med engelsk, gik det galt. Så jeg troede blot, at jeg kunne ændre de små ting.
#71, tænker jeg ikke der er grund til, da Jan har udført koden og det er blot en linje som er problemet?
Formula = "=IF........" (uden Local, engelsk formel) Makro skrives på engelsk også formlen så virker det både i dansk og engelsk ver. FormulaLocal = "=Hvis........" (med local, dansk formel) virker kun i dansk excel ver. FormulaLocal = "=IF........" (med local, engelsk formel) virker kun i engelsk excel ver.
Sub Indsætformel() For Each rcell In Range("D2", "D22") rcell.Formula = "=IF(Find_tal(C" & rcell.Row & ")=0,"""", Find_tal(C" & rcell.Row & "))" Next End Sub
Sub Indsæt_formel_i_aktive_celle() Select Case Application.International(xlCountryCode) Case 1: 'English 1 (The United States of America) ActiveCell.Formula = "=IF(A1="""",""A1 Is empty"",""A1 Is not empty"")" Case 45: 'Danish 45 (Denmark) ActiveCell.Formula = "=IF(A1="""",""A1 er Tom"",""A1 er Ikke tom"")" Case Else: MsgBox "(Country code not defined!)" End Select 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.
