redigere felt med makro

Hva' med at bruge Instr() til at finde hvor # er placeret
og dernæst bruge right()

#=linieskift
Den kan jeg ikke finde med Instr() såvidt jeg ved.

Hva' med vbLfCr

Nu er jeg ikke specielt rutineret i VB ... såeh..
Hvad gør den.
Evt. vis et eks.

Ja altså vbCrLf kan anvendes til linieskift således:
msgbox "Testtekst" & vbCrLf & "MereTestTekst"

aha - går heller ikke. Har jeg prøvet med.

Nu har jeg fundet løsningen, vent lige en studs...

Bemærk dog at denne code skal tilrettes for at kunne anvendes i et bredere omfang OG at den også kan optimeres yderligere...

Dim lRv As Long
Dim sString As String

lRv = InStr(1, sfeltn, CStr(vbCrLf))
sString = Mid(sString, lRv + 2)
lRv = InStr(1, sString, CStr(vbCrLf))
sString = Mid(sString, lRv + 2, 4)

Mvh Jan

Nope..
Hvis jeg nu kan løbe strengen igenne bagfra, udtrække de 4 første tal der findes - og indsætte dem i omvendt rækkefølge. Så det bare lige hvordan jeg gør det?

Den her returnere tallene, men bare fra starten af i stedet for slutningen.

sVærdi = Selection.Value
    sVærdi = Trim(sVærdi)  'fjerner leading og trailing spaces
    q = Len(sVærdi)
   
    For x = 1 To q
        Select Case Mid(sVærdi, x, 1)
        Case 1: u = u + Mid(sVærdi, x, 1)
        Case 2: u = u + Mid(sVærdi, x, 1)
        Case 3: u = u + Mid(sVærdi, x, 1)
        Case 4: u = u + Mid(sVærdi, x, 1)
        Case 5: u = u + Mid(sVærdi, x, 1)
        Case 6: u = u + Mid(sVærdi, x, 1)
        Case 7: u = u + Mid(sVærdi, x, 1)
        Case 8: u = u + Mid(sVærdi, x, 1)
        Case 9: u = u + Mid(sVærdi, x, 1)
        Case 0: u = u + Mid(sVærdi, x, 1)
        End Select
    Next x
    Selection.Value = u

sVærdi = Selection.Value
    sVærdi = Trim(sVærdi)  'fjerner leading og trailing spaces
    q = Len(sVærdi)

e$= ""
s1$ = ""
samlet$
for x = q to (q-4) step -1
e$ = mid(sværdi,x,1)
samlet$ = e$ & s1$
s1$= samlet$
next x

- Mikker

Jeg er jo tilsyneladende ikke rigtig klog :O) Der var vist nok noget med at det skulle vendes på vrangen... Anyway:

Range("A1").Select
sVærdi = Selection.Value
sVærdi = Trim(sVærdi)  'fjerner leading og trailing spaces
q = Len(sVærdi)
e$ = ""
s1$ = ""
samlet$ = ""
For x = 0 To 3
e$ = Mid(sVærdi, (q - x), 1)
samlet$ = s1$ & e$
s1$ = samlet$
Next x
Range("A3").Value = s1$
End Sub

Virker hos mig...

- Mikker

Måske med lidt forklaringer til, så skal jeg nok fjerne fingrene fra tastaturet.

Range("A1").Value = "NAVN4321"
Range("A1").Select
sVærdi = Selection.Value
sVærdi = Trim(sVærdi)  'fjerner leading og trailing spaces
q = Len(sVærdi)
e$ = ""
s1$ = ""
For x = 0 To 3 ' vi leder efter 4 tegn (q-0),(q-1)...(q-3)
e$ = Mid(sVærdi, (q - x), 1)
'ved første gennemløb: e$ = Mid("NAVN4321",(8-0),1) eller: "1"
s1$ = s1$ & e$
Next x
Range("A3").Value = s1$
e$ = ""
End Sub

- Mikker

Monty ->Prøv lige denne funktion, hvis du koder i vba og excel2000 og op.

Function postnr(s As String) As String
Dim t As Long
t = InStrRev(s, Chr(10)) + 1
postnr = Mid(s, t, 4)
End Function

eller som makro hvor hele adressen udskiftes med postnr og der flyttes til næste celle.

Sub postnr1()
Dim t As Long
Dim s As String
s = ActiveCell.Value
t = InStrRev(s, Chr(10)) + 1
ActiveCell.Value = Mid(s, t, 4)
ActiveCell.Offset(1, 0).Select
End Sub

Denne bør virke (VBA)
sub TrimToZip()
Dim lRv As Long
Dim sString As String

sString=cells(Række,Kolonne).value

lRv = InStrRev(sString, CStr(vbCrLf))
sString = Mid(sString, lRv + 2, 4)

Cells(Række,Kolonne).Value=sStreng
End sub

jrl -> skal det virke, mener jeg, du er nødt til at bruge vbLf (chr(10)) istedet for vbCrLf

Hej bak
Jaeh... det kan du godt have ret i. Subens virke forudsættes af hvorvidt linieskiftet er det ene (CrLf) eller det andet (Lf) i den aktuelle celle. Men det kan uden videre rettes ved denne sub...

sub TrimToZip()
Dim lRv As Long
Dim sString As String

sString=cells(Række,Kolonne).value

lRv = InStrRev(sString, CStr(vbLf))
sString = Mid(sString, lRv + 1, 4)

Cells(Række,Kolonne).Value=sStreng
End sub

Mvh Jan

Rettelse:
Sub TrimToZip()
Dim lRv As Long
Dim sString As String
Dim Række As Long
Dim Kolonne As Long

'Angiv rææke,kolonne
Række = 1
Kolonne = 1

sString = Cells(Række, Kolonne).Value

lRv = InStrRev(sString, CStr(vbLf))
sString = Mid(sString, lRv + 1, 4)

Cells(Række, Kolonne).Value = sString
End Sub

Denne her virker til formålet - den er simpel, ikke særlig køn og har en temlig dårlig tidskompleksitet, men det er kun 3000-4000 rækker den skal igennem, så det går.

Sub Makro1()
While ActiveCell.Offset(0, -2).Range("A1") <> ""
    ActiveCell.Offset(0, -2).Range("A1").Select
    Selection.Copy
    ActiveCell.Offset(0, 2).Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
     
    Dim strHolder As String
    Dim a, b, s, s1, q, x, z, sVærdi
    a = 1
 
    sVærdi = Selection.Value
    sVærdi = Trim(sVærdi)
    q = Len(sVærdi)
    For x = 1 To q
        E = Mid(sVærdi, x, 1)
        Select Case Mid(sVærdi, x, 1)
        Case 1: u = u + E
        Case 2: u = u + E
        Case 3: u = u + E
        Case 4: u = u + E
        Case 5: u = u + E
        Case 6: u = u + E
        Case 7: u = u + E
        Case 8: u = u + E
        Case 9: u = u + E
        Case 0: u = u + E
        End Select
    Next x
    u = Right(u, 4)
    Selection.Value = u
    ActiveCell.Offset(1, 0).Range("A1").Select
Wend
End Sub

Der var ikke rigtig nogen af jeres forslag der var helt kompatibel med mit hoved. Men tak for inspirationen.

Besøndligt! Go' week end