kalender til sommerhusudlejning

Det skulle nok være muligt.

Har du mulig for at fremstille en model, som du kunne sende? @-adresse under min profil.

og så velkommen til Eksperten..

Jeg har netop sendt dig en mail med mit udkast - hvis du skal bruge andet - så lad mig endelig høre :)

Tak :)

//Iris

Har jeg gjort noget forkert - tror det er mig selv jeg giver point og ikke "supertekst"????!

Ingen panik..

Du skal kun anvende KOMMENTAR til at besvare indlæg. SVAR anvendes kun af forslagsstillere, når de fremsender en løsning, der måske kan ACCEPTERES af opgavestilleren.

Opgavestiller skal så i givet fald Acceptere et Svar - dette giver points.

Nåååh - det giver mening..

Tusinde tak... :)

Selv tak - du er ikke den første ..

Tusinde tak for hjælpen ...

aha... sådan gør jeg...

Selv tak - fred være med points - jeg lægger løsningen her.

Rem Placeres under ark Feriehus Kalender
Rem ====================================
Const antalHuse = 2
Const rækkerPrHus = 7

Dim arkTast As Worksheet, arkTastRækker As Long, rækNr As Long
Dim ugeNr, årstal As Integer, hus As String

Dim arkKalender As Worksheet, arkKalenderRækker As Long
Const farveLedig = 50
Const farveOptaget = 3
Public Sub opdaterFeriehusKalender()
    Application.ScreenUpdating = False
    Set arkKalender = ActiveWorkbook.Sheets(2)
    arkKalenderRækker = ActiveCell.SpecialCells(xlLastCell).Row
   
    Set arkTast = ActiveWorkbook.Sheets(1)
    arkTast.Select
    arkTastRækker = ActiveCell.SpecialCells(xlLastCell).Row
   
Rem neutraliseres inden opdatering
    friGivRødeCeller
   
    With arkTast
        For rækNr = 2 To arkTastRækker
            ugeNr = .Range("A" & rækNr)
            årstal = .Range("B" & rækNr)
            hus = .Range("D" & rækNr)
   
        If ugeNr <> "" And CStr(årstal) <> "" And hus <> "" Then
            opdaterKalender ugeNr, "perioder " & CStr(årstal), hus
        End If
        Next rækNr
    End With
   
    arkKalender.Select
   
    Application.ScreenUpdating = True
End Sub
Private Sub opdaterKalender(ugeNr, søgEfter As String, hus)
Dim årsTalRække As Long, husrække As Long, ugeNrAdresse As String
    With arkKalender
        årsTalRække = findÅrsTalRække(søgEfter)
        If årsTalRække > 0 Then
            husrække = findHusRække(årsTalRække, hus)
           
            If husrække > 0 Then
                ugeNrAdresse = findUgeNrPlads(husrække, ugeNr)
                Range(ugeNrAdresse).Offset(1, 0).Interior.ColorIndex = farveOptaget
            End If
        End If
    End With
   
    arkTast.Select
End Sub
Private Function findÅrsTalRække(søgEfter As String)
Dim c
    arkKalender.Select
    With Range("A1:AB" & CStr(arkKalenderRækker))
        Set c = .Find(søgEfter, LookIn:=xlValues, LookAt:=xlPart)
        If Not c Is Nothing Then
            findÅrsTalRække = c.Row
        Else
            findÅrsTalRække = 0
        End If
    End With
End Function
Private Function findHusRække(årsTalRække, hus)
Dim c
    arkKalender.Select
    With Range("A" & CStr(årsTalRække) & ":AB" & CStr(årsTalRække + (antalHuse * rækkerPrHus)))
        Set c = .Find(hus, LookIn:=xlValues, LookAt:=xlPart)
        If Not c Is Nothing Then
            findHusRække = c.Row
        Else
            findHusRække = 0
        End If
    End With
End Function
Private Function findUgeNrPlads(husrække, ugeNr)
Dim c
    With Range("A" & CStr(husrække) & ":AB" & CStr(husrække + rækkerPrHus))
        Set c = .Find(ugeNr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findUgeNrPlads = c.Address
        Else
            findUgeNrPlads = ""
        End If
    End With
End Function
Private Sub friGivRødeCeller()
Dim cc As Object
    arkKalender.Select
   
    For Each cc In Range("A2:AB" & CStr(arkKalenderRækker)).Cells
        If cc.Interior.ColorIndex = farveOptaget Then
            cc.Interior.ColorIndex = farveLedig
        End If
    Next cc
End Sub
Private Sub CommandButton1_Click()
    opdaterFeriehusKalender
End Sub

Tusinde tak... ... din løsning er rigtig god... kører perfekt :)

er ked af at jeg rodede sådan rundt i point systemet...

God weekend :)

Selv tak og i lige måde..

Hej Jeg kan se det er en ældre tråd, men jeg har samme ønske til en kalender men kan ikke finde ud af hvordan jeg anvender løsningen/koden? Kan det også bruges i OpenOffice?
Hvad skal jeg nøjagtig gøre?

Hej Olaf13

Har ingen erfaring med OpenOffice - arbejder kun med Microsoft Office..

Ok den har jeg også men hvordan gør jeg lige med den koden?
Bare i store træk?

Prøv at henvende dig til opgavestilleren..

Hej Iris
Hvordan fik du den kalender i Excel'te op og køre?? Jeg har også 2 udlejningssommerhus at holde styr på.