Macro til at rette i uger

Hvis du markerer cellerne, du ønsker at ændre og kører denne makro, bliver teksten i cellerne ændret.

Sub Uge()
Dim C, Omr As Range
On Error Resume Next
Dim LastRow, K, F, S, R, X As Integer
Set Omr = Selection
For Each C In Omr
K = WorksheetFunction.Find("-", C)
F = Mid(C, K - 2, 2) * 1
S = Mid(C, K + 1, 2) * 1
C.Value = "Uge " & F
For X = F + 1 To S
C.Value = C.Value & " + " & X
Next
Next
End Sub

Hej

Tusind tak for forslaget, hvis jeg ikke selv skal markere felterne. Men blot gøres fra kolonne D, automatik. Er det muligt?

Med resultatet I same celler?

Ja tak 😊

Hvis du kender dit område, så prøv at udskifte:

Set Omr = Selection
Med:
Set Omr = Range("D4:D7")

Umiddelbart virker koden fint nok, hvis der er "uge 30-32". Men hvis der bare står uge 20, så sletter den det og skriver Uge 4 - andre steder skriver den bare Uge.

Ah det er hvis der f.eks. står Uge 40, så bliver den rettet til Uge 4 og samme med andre.

Jeg har brugt Store-Mortens forslag til at vælge et bestemt område i D-kolonnen. Ret selv hvis det ikke passer. Desuden testes der nu om cellen er tom og om der kun står en uge i cellen.

Sub Uge()
Dim C, Omr As Range
On Error Resume Next
Dim LastRow, K, F, S, R, X As Integer
Set Omr = Range("D2:D17") ' ret området
For Each C In Omr
S = 0
If C <> "" Then
K = WorksheetFunction.Find("-", C)
If K = "" Then
Else
F = Mid(C, K - 2, 2) * 1
S = Mid(C, K + 1, 2) * 1
C.Value = "Uge " & F
For X = F + 1 To S
C.Value = C.Value & " + " & X
Next
End If
End If
Next
End Sub

Sub Uge()
Dim C, Omr As Range
On Error Resume Next
Dim K, F, S, R, X As Integer
Set Omr = Selection
For Each C In Omr
K = WorksheetFunction.Find("-", C)

If IsEmpty(K) Then GoTo Næste

F = Mid(C, K - 2, 2) * 1
S = Mid(C, K + 1, 2) * 1
C.Value = "Uge " & F
    For X = F + 1 To S
    C.Value = C.Value & " + " & X
    Next
Næste:
Next
End Sub

Hej igen Jens

Den laver samme nummer, så den skriver Uge 4 ved f.eks. Uge 43

Tak for dit forsøg!

Det samme gør din store-morten, tak for forslaget også.

Det var mærkeligt?
Den skulle gerne springe de celler over der ikke indeholder - (bindestreg)

K = WorksheetFunction.Find("-", C)
If IsEmpty(K) Then GoTo Næste

Jeg har ikke nogle bindestreg i dem, hvor den retter det til Uge 4 fra Uge 43. Der står kun Uge 43.

Ved ikke, om der findes en anden udvej?

Har du mulighed for at uploade et eks.ark der fejler?

#14 Beklager det sene svar, men efter jeg oprettede tingene på ny. Så virker det perfekt. Tusind tak for hjælpen begge to!