Opdele VBA kode, som er for lang
Hejsa,Hvordan opdeler man en VBA kode som er for lang?
Nedenfor viser jeg et udklip af koden. Den fylder meget, fordi den skal gentage det neden for som er Dok III, for de andre dokker og nu ville jeg tilføje en bedding, men så blev proceduren for lang.
Men jeg har prøvet at sætte beddingen ind som en anden Sub, men tror ikke den læser den.....
Sub Booking()
Application.ScreenUpdating = False
Call Lav_Kalender_Ny 'Henter macroen som laver kalenderen
Dim ws3 As Worksheet, ws1 As Worksheet, ws2 As Worksheet, ws4 As Worksheet
Dim PeriodeStart As Date, PeriodeSlut As Date, AnkomstVaerft As Date, AfgangVaerft As Date, AnkomstDok As Date, AfgangDok As Date
Dim ProjectCount As Integer, Counter As Integer, Periode As Integer, PeriodeSkib As Integer, StartAnkomst As Integer, PeriodeDokSlut As Integer, RowCount As Long, PeriodeDok As Integer, ColumnCount As Integer, LineCount As Integer
Dim Dok As String, WeekDay As String, laydaysDok3 As Integer, CounterStatistikDok As Integer
Dim VDate As Boolean
Set ws1 = Sheets("Indtastningsark")
Set ws3 = Sheets("Vis_Oversigt")
Set ws2 = Sheets("Statistik")
Set ws4 = Sheets("MIS")
VDate = IsDate(Range("C4"))
If VDate = False Then
Exit Sub
End If
VDate = IsDate(Range("E4"))
If VDate = False Then
Exit Sub
End If
If ws3.Cells(4, 6) > 400 Then
Exit Sub
End If
If ws3.Cells(4, 6) < 0 Then
Exit Sub
End If
ActiveSheet.Unprotect Password:="5980"
PeriodeStart = ws3.Cells(4, 3).Value 'PeriodeStart er start datoen for kalenderen (indtastes på Vis_Oversigt)
PeriodeSlut = ws3.Cells(4, 5).Value 'PeriodeSlut er slutdatoen for kalenderen (Indtastes på Vis_Oversigt)
Periode = ws3.Cells(4, 6) 'Perioden er det antal dage som kalenderen løber
Counter = 7 ' Counter er sat til 7, da projekterne skal indføres fra og med række 7 på Vis_Oversigt
ProjectCount = ws1.Range("B" & Rows.Count).End(xlUp).Row 'Finder antallet af indførte projekter på sheet Indtastningsark
RowCount = ws3.Range("B" & Rows.Count).End(xlUp).Row 'Finder antallet af indførte rækker på sheet Vis_Oversigt
ws3.Range(Cells(6, 1), Cells(RowCount, 9)).UnMerge
ws3.Range(Cells(6, 1), Cells(RowCount, 9)).Clear 'Sletter hentede projekter på sheet Vis_Oversigt
ws3.Range(Cells(3, 1), Cells(RowCount + 6, 1)).RowHeight = 18
ws3.Columns("A:A").NumberFormat = "@"
ws4.Activate
Range(Cells(1, 1), Cells(5, 500)).Clear
ws3.Activate
laydaysDok3 = 0
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Her følger algortimen for Pre Booking - Dok III
'Følgende algoritme kontrollerer om projektet ligger inden for PeriodeStart og PeriodeSlut og henter dem over i sheet Vis_Oversigt fra Sheet Indtastningsark. Sorteret efter DOK/KAJ
For j = 3 To ProjectCount
AnkomstVaerft = ws1.Cells(j, 5).Value 'Tidspunkt projekt ankommer til værft
AfgangVaerft = ws1.Cells(j, 6).Value 'Tidspunkt skib afgår fra vaerft
Dok = ws1.Cells(j, 7).Value 'Projektets doknummer eller langs kaj
AnkomstDok = ws1.Cells(j, 8).Value 'Tidspunkt projekt går i dok(såfremt det gør dette)
AfgangDok = ws1.Cells(j, 9).Value 'Tidspunkt projekt kommer ud af dok(såfremt det gør dette)
CounterStatistikDok = 0
If (AnkomstVaerft >= PeriodeStart And AnkomstVaerft <= PeriodeSlut And Dok = "DOK III") Then 'Tjekker om ankomst ligger inden for perioden og at skibet skal i DOK xxx
ws3.Range(Cells(Counter - 1, 1), Cells(Counter + 1, 1)).Merge
ws3.Range(Cells(Counter - 1, 2), Cells(Counter + 1, 2)).Merge
ws3.Range(Cells(Counter - 1, 3), Cells(Counter + 1, 3)).Merge
ws3.Range(Cells(Counter - 1, 4), Cells(Counter + 1, 4)).Merge
ws3.Range(Cells(Counter - 1, 5), Cells(Counter + 1, 5)).Merge
ws3.Range(Cells(Counter - 1, 6), Cells(Counter + 1, 6)).Merge
ws3.Range(Cells(Counter - 1, 7), Cells(Counter + 1, 7)).Merge
ws3.Range(Cells(Counter - 1, 8), Cells(Counter + 1, 8)).Merge
ws3.Cells(Counter - 1, 1).Value = ws1.Cells(j, 1).Value 'Overfører værdier fra sheet Indtastningsark til Sheet Vis_Oversigt
ws3.Cells(Counter - 1, 2).Value = ws1.Cells(j, 2).Value
ws3.Cells(Counter - 1, 3).Value = ws1.Cells(j, 3).Value
ws3.Cells(Counter - 1, 4).Value = ws1.Cells(j, 4).Value
ws3.Cells(Counter - 1, 5).Value = ws1.Cells(j, 7).Value
ws3.Cells(Counter - 1, 7).Value = ws1.Cells(j, 5).Value
ws3.Cells(Counter - 1, 8).Value = ws1.Cells(j, 6).Value
If PeriodeSlut < AfgangVaerft Then 'Tjekker om skibet afgår værft efter kalender slutdato(dette gøres for at undgå markering ud over kalenderens område)
PeriodeSkib = Periode 'PeriodeSkib defineres til at være samme tidsrum som kalenderen(alene for at undgå markering ud over kalenderens område)
Else
PeriodeSkib = ws1.Cells(j, 6) - PeriodeStart 'Hvis skibet afgår værft før kalenderen slutter, er PeriodeSkib defineret til at være fra startdato af kalender til afgang skib
End If
ws3.Range(Cells(Counter, ((AnkomstVaerft - PeriodeStart) + 10)), Cells(Counter, PeriodeSkib + 10)).Interior.ColorIndex = 5 'Farver Rangen blå i kalenderen
If AnkomstDok <> "00:00:00" And AfgangDok <> "00:00:00" Then 'Tjekker om skibet er sat til at skulle i dok
If AnkomstDok >= PeriodeStart And AnkomstDok <= PeriodeSlut Then 'Tjekker om ankomsten ligger inden for kalenderperioden
If PeriodeSlut <= AfgangDok Then 'Tjekker om dokperioden løber hele kalenderperioden
PeriodeDokSlut = Periode
ElseIf PeriodeSlut >= AfgangDok Then 'tjekker om dokperioden udløber før kalenderperioden
PeriodeDokSlut = ws1.Cells(j, 9) - PeriodeStart
End If
ws3.Range(Cells(Counter, ((AnkomstDok - PeriodeStart) + 10)), Cells(Counter, PeriodeDokSlut + 10)).Interior.ColorIndex = 3
ws4.Activate
Range(Cells(1, ((AnkomstDok - PeriodeStart) + 1)), Cells(1, PeriodeDokSlut + 1)).Value = 1
ws3.Activate
'CounterStatistikDok = PeriodeDokSlut - (AnkomstDok - PeriodeStart) 'TY
End If
End If
Counter = Counter + 3 'rykker counter og springer linje over
ElseIf PeriodeStart > AnkomstVaerft And PeriodeSlut < AfgangVaerft And Dok = "DOK III" Then
ws3.Range(Cells(Counter - 1, 1), Cells(Counter + 1, 1)).Merge
ws3.Range(Cells(Counter - 1, 2), Cells(Counter + 1, 2)).Merge
ws3.Range(Cells(Counter - 1, 3), Cells(Counter + 1, 3)).Merge
ws3.Range(Cells(Counter - 1, 4), Cells(Counter + 1, 4)).Merge
ws3.Range(Cells(Counter - 1, 5), Cells(Counter + 1, 5)).Merge
ws3.Range(Cells(Counter - 1, 6), Cells(Counter + 1, 6)).Merge
ws3.Range(Cells(Counter - 1, 7), Cells(Counter + 1, 7)).Merge
ws3.Range(Cells(Counter - 1, 8), Cells(Counter + 1, 8)).Merge
ws3.Cells(Counter - 1, 1).Value = ws1.Cells(j, 1).Value 'Overfører værdier fra sheet Indtastningsark til Sheet Vis_Oversigt
ws3.Cells(Counter - 1, 2).Value = ws1.Cells(j, 2).Value
ws3.Cells(Counter - 1, 3).Value = ws1.Cells(j, 3).Value
ws3.Cells(Counter - 1, 4).Value = ws1.Cells(j, 4).Value
ws3.Cells(Counter - 1, 5).Value = ws1.Cells(j, 7).Value
ws3.Cells(Counter - 1, 7).Value = ws1.Cells(j, 5).Value
ws3.Cells(Counter - 1, 8).Value = ws1.Cells(j, 6).Value
Range(Cells(Counter, 10), Cells(Counter, Periode + 10)).Interior.ColorIndex = 5
If AnkomstDok <> "00:00:00" And AfgangDok <> "00:00:00" Then 'Tjekker om skibet er sat til at skulle i dok
If PeriodeStart >= AnkomstDok And PeriodeSlut <= AfgangDok Then 'Tjekker om kalenderperioden optræder i værftsperioden
Range(Cells(Counter, 10), Cells(Counter, Periode + 10)).Interior.ColorIndex = 3
ws4.Activate
Range(Cells(1, 1), Cells(1, Periode + 1)).Value = 1
ws3.Activate
'CounterStatistikDok = Periode
End If
If AnkomstDok >= PeriodeStart And AnkomstDok <= PeriodeSlut Then 'Tjekker om ankomsten ligger inden for kalenderperioden
If PeriodeSlut <= AfgangDok Then
PeriodeDokSlut = Periode
ElseIf PeriodeSlut > AfgangDok Then
PeriodeDokSlut = ws1.Cells(j, 9) - PeriodeStart
End If
ws3.Range(Cells(Counter, ((AnkomstDok - PeriodeStart) + 10)), Cells(Counter, PeriodeDokSlut + 10)).Interior.ColorIndex = 3
ws4.Activate
ws4.Range(Cells(1, ((AnkomstDok - PeriodeStart) + 1)), Cells(1, PeriodeDokSlut + 1)).Value = 1
ws3.Activate
'CounterStatistikDok = (AnkomstDok - PeriodeStart) - PeriodeDokSlut
End If
If AnkomstDok < PeriodeStart And AfgangDok <= PeriodeSlut Then
Range(Cells(Counter, 10), Cells(Counter, (AfgangDok - PeriodeStart) + 10)).Interior.ColorIndex = 3
ws4.Activate
Range(Cells(1, 1), Cells(1, (AfgangDok - PeriodeStart) + 1)).Value = 1
ws3.Activate
'CounterStatistikDok = (AfgangDok - PeriodeStart)
End If
End If
Counter = Counter + 3
ElseIf AfgangVaerft >= PeriodeStart And AfgangVaerft <= PeriodeSlut And AnkomstVaerft < PeriodeStart And Dok = "DOK III" Then
ws3.Range(Cells(Counter - 1, 1), Cells(Counter + 1, 1)).Merge
ws3.Range(Cells(Counter - 1, 2), Cells(Counter + 1, 2)).Merge
ws3.Range(Cells(Counter - 1, 3), Cells(Counter + 1, 3)).Merge
ws3.Range(Cells(Counter - 1, 4), Cells(Counter + 1, 4)).Merge
ws3.Range(Cells(Counter - 1, 5), Cells(Counter + 1, 5)).Merge
ws3.Range(Cells(Counter - 1, 6), Cells(Counter + 1, 6)).Merge
ws3.Range(Cells(Counter - 1, 7), Cells(Counter + 1, 7)).Merge
ws3.Range(Cells(Counter - 1, 8), Cells(Counter + 1, 8)).Merge
ws3.Cells(Counter - 1, 1).Value = ws1.Cells(j, 1).Value 'Overfører værdier fra sheet Indtastningsark til Sheet Vis_Oversigt
ws3.Cells(Counter - 1, 2).Value = ws1.Cells(j, 2).Value
ws3.Cells(Counter - 1, 3).Value = ws1.Cells(j, 3).Value
ws3.Cells(Counter - 1, 4).Value = ws1.Cells(j, 4).Value
ws3.Cells(Counter - 1, 5).Value = ws1.Cells(j, 7).Value
ws3.Cells(Counter - 1, 7).Value = ws1.Cells(j, 5).Value
ws3.Cells(Counter - 1, 8).Value = ws1.Cells(j, 6).Value
Range(Cells(Counter, 10), Cells(Counter, (AfgangVaerft - PeriodeStart) + 10)).Interior.ColorIndex = 5
If AnkomstDok <> "00:00:00" And AfgangDok <> "00:00:00" Then 'Tjekker om skibet er sat til at skulle i dok
If PeriodeStart >= AnkomstDok And AfgangDok >= PeriodeStart Then 'Tjekker om kalenderperioden optræder i værftsperioden
Range(Cells(Counter, 10), Cells(Counter, ((AfgangDok - PeriodeStart) + 10))).Interior.ColorIndex = 3
ws4.Activate
Range(Cells(1, 1), Cells(1, ((AfgangDok - PeriodeStart) + 1))).Value = 1
ws3.Activate
'CounterStatistikDok = (AfgangDok - PeriodeStart)
End If
If AnkomstDok >= PeriodeStart Then 'Tjekker om ankomsten ligger inden for kalenderperioden
ws3.Range(Cells(Counter, ((AnkomstDok - PeriodeStart) + 10)), Cells(Counter, (AfgangDok - PeriodeStart) + 10)).Interior.ColorIndex = 3
ws4.Activate
Range(Cells(1, ((AnkomstDok - PeriodeStart) + 1)), Cells(1, (AfgangDok - PeriodeStart) + 1)).Value = 1
ws3.Activate
'CounterStatistikDok = (AfgangDok - PeriodeStart) - (AnkomstDok - PeriodeStart)
End If
If AnkomstDok <= PeriodeStart And AfgangDok > PeriodeStart Then
Range(Cells(Counter, 10), Cells(Counter, (AfgangDok - PeriodeStart) + 10)).Interior.ColorIndex = 3
ws4.Activate
Range(Cells(1, 1), Cells(1, (AfgangDok - PeriodeStart) + 1)).Value = 1
ws3.Activate
'CounterStatistikDok = (AfgangDok - PeriodeStart)
End If
End If
Counter = Counter + 3
End If
'If CounterStatistikDok > 0 Then
' CounterStatistikDok = CounterStatistikDok + 1
'End If
'laydaysDok3 = laydaysDok3 + CounterStatistikDok
'ws2.Cells(5, 2).Value = laydaysDok3
'ws2.Cells(5, 2).Value = Excel.WorksheetFunction.Sum(ws4.Range("A1:A500"))
Next j
Call Bedding
Og herunder næsten det samme som oven for, for de næste dokke.
Jeg har prøvet at lave Sub for Bedding med og uden det der er oven for linjen med teksten: 'Her følger algortimen for Bedding
Sub for bedding:
Sub Bedding()
Application.ScreenUpdating = False
'Call Lav_Kalender_Ny 'Henter macroen som laver kalenderen
Dim ws3 As Worksheet, ws1 As Worksheet, ws2 As Worksheet, ws4 As Worksheet
Dim PeriodeStart As Date, PeriodeSlut As Date, AnkomstVaerft As Date, AfgangVaerft As Date, AnkomstDok As Date, AfgangDok As Date
Dim ProjectCount As Integer, Counter As Integer, Periode As Integer, PeriodeSkib As Integer, StartAnkomst As Integer, PeriodeDokSlut As Integer, RowCount As Long, PeriodeDok As Integer, ColumnCount As Integer, LineCount As Integer
Dim Dok As String, WeekDay As String, laydaysDok3 As Integer, CounterStatistikDok As Integer
Dim VDate As Boolean
Set ws1 = Sheets("Indtastningsark")
Set ws3 = Sheets("Vis_Oversigt")
Set ws2 = Sheets("Statistik")
Set ws4 = Sheets("MIS")
VDate = IsDate(Range("C4"))
If VDate = False Then
Exit Sub
End If
VDate = IsDate(Range("E4"))
If VDate = False Then
Exit Sub
End If
If ws3.Cells(4, 6) > 400 Then
Exit Sub
End If
If ws3.Cells(4, 6) < 0 Then
Exit Sub
End If
'Her følger algortimen for Bedding
For j = 3 To ProjectCount
AnkomstVaerft = ws1.Cells(j, 5).Value 'Tidspunkt projekt ankommer til værft
AfgangVaerft = ws1.Cells(j, 6).Value 'Tidspunkt skib afgår fra vaerft
Dok = ws1.Cells(j, 7).Value 'Projektets doknummer eller langs kaj
AnkomstDok = ws1.Cells(j, 8).Value 'Tidspunkt projekt går i dok(såfremt det gør dette)
AfgangDok = ws1.Cells(j, 9).Value 'Tidspunkt projekt kommer ud af dok(såfremt det gør dette)
If (AnkomstVaerft >= PeriodeStart And AnkomstVaerft <= PeriodeSlut And Dok = "Bedding") Then 'Tjekker om ankomst ligger inden for perioden og at skibet skal i DOK xxx
ws3.Range(Cells(Counter - 1, 1), Cells(Counter + 1, 1)).Merge
ws3.Range(Cells(Counter - 1, 2), Cells(Counter + 1, 2)).Merge
ws3.Range(Cells(Counter - 1, 3), Cells(Counter + 1, 3)).Merge
ws3.Range(Cells(Counter - 1, 4), Cells(Counter + 1, 4)).Merge
ws3.Range(Cells(Counter - 1, 5), Cells(Counter + 1, 5)).Merge
ws3.Range(Cells(Counter - 1, 6), Cells(Counter + 1, 6)).Merge
ws3.Range(Cells(Counter - 1, 7), Cells(Counter + 1, 7)).Merge
ws3.Range(Cells(Counter - 1, 8), Cells(Counter + 1, 8)).Merge
ws3.Cells(Counter - 1, 1).Value = ws1.Cells(j, 1).Value 'Overfører værdier fra sheet Indtastningsark til Sheet Vis_Oversigt
ws3.Cells(Counter - 1, 2).Value = ws1.Cells(j, 2).Value
ws3.Cells(Counter - 1, 3).Value = ws1.Cells(j, 3).Value
ws3.Cells(Counter - 1, 4).Value = ws1.Cells(j, 4).Value
ws3.Cells(Counter - 1, 5).Value = ws1.Cells(j, 7).Value
ws3.Cells(Counter - 1, 7).Value = ws1.Cells(j, 5).Value
ws3.Cells(Counter - 1, 8).Value = ws1.Cells(j, 6).Value
If PeriodeSlut < AfgangVaerft Then 'Tjekker om skibet afgår værft efter kalender slutdato(dette gøres for at undgå markering ud over kalenderens område)
PeriodeSkib = Periode 'PeriodeSkib defineres til at være samme tidsrum som kalenderen(alene for at undgå markering ud over kalenderens område)
Else
PeriodeSkib = ws1.Cells(j, 6) - PeriodeStart 'Hvis skibet afgår værft før kalenderen slutter, er PeriodeSkib defineret til at være fra startdato af kalender til afgang skib
End If
ws3.Range(Cells(Counter, ((AnkomstVaerft - PeriodeStart) + 10)), Cells(Counter, PeriodeSkib + 10)).Interior.ColorIndex = 5 'Farver Rangen blå i kalenderen
If AnkomstDok <> "00:00:00" And AfgangDok <> "00:00:00" Then 'Tjekker om skibet er sat til at skulle i dok
If AnkomstDok >= PeriodeStart And AnkomstDok <= PeriodeSlut Then 'Tjekker om ankomsten ligger inden for kalenderperioden
If PeriodeSlut <= AfgangDok Then 'Tjekker om dokperioden løber hele kalenderperioden
PeriodeDokSlut = Periode
ElseIf PeriodeSlut >= AfgangDok Then 'tjekker om dokperioden udløber før kalenderperioden
PeriodeDokSlut = ws1.Cells(j, 9) - PeriodeStart
End If
ws3.Range(Cells(Counter, ((AnkomstDok - PeriodeStart) + 10)), Cells(Counter, PeriodeDokSlut + 10)).Interior.ColorIndex = 43
ws4.Activate
Range(Cells(2, ((AnkomstDok - PeriodeStart) + 1)), Cells(2, PeriodeDokSlut + 1)).Value = 1
ws3.Activate
End If
End If
Counter = Counter + 3 'rykker counter og springer linje over
ElseIf PeriodeStart >= AnkomstVaerft And PeriodeSlut <= AfgangVaerft And Dok = "Bedding" Then
ws3.Range(Cells(Counter - 1, 1), Cells(Counter + 1, 1)).Merge
ws3.Range(Cells(Counter - 1, 2), Cells(Counter + 1, 2)).Merge
ws3.Range(Cells(Counter - 1, 3), Cells(Counter + 1, 3)).Merge
ws3.Range(Cells(Counter - 1, 4), Cells(Counter + 1, 4)).Merge
ws3.Range(Cells(Counter - 1, 5), Cells(Counter + 1, 5)).Merge
ws3.Range(Cells(Counter - 1, 6), Cells(Counter + 1, 6)).Merge
ws3.Range(Cells(Counter - 1, 7), Cells(Counter + 1, 7)).Merge
ws3.Range(Cells(Counter - 1, 8), Cells(Counter + 1, 8)).Merge
ws3.Cells(Counter - 1, 1).Value = ws1.Cells(j, 1).Value 'Overfører værdier fra sheet Indtastningsark til Sheet Vis_Oversigt
ws3.Cells(Counter - 1, 2).Value = ws1.Cells(j, 2).Value
ws3.Cells(Counter - 1, 3).Value = ws1.Cells(j, 3).Value
ws3.Cells(Counter - 1, 4).Value = ws1.Cells(j, 4).Value
ws3.Cells(Counter - 1, 5).Value = ws1.Cells(j, 7).Value
ws3.Cells(Counter - 1, 7).Value = ws1.Cells(j, 5).Value
ws3.Cells(Counter - 1, 8).Value = ws1.Cells(j, 6).Value
Range(Cells(Counter, 10), Cells(Counter, Periode + 10)).Interior.ColorIndex = 5
If AnkomstDok <> "00:00:00" And AfgangDok <> "00:00:00" Then 'Tjekker om skibet er sat til at skulle i dok
If PeriodeStart >= AnkomstDok And PeriodeSlut <= AfgangDok Then 'Tjekker om kalenderperioden optræder i værftsperioden
Range(Cells(Counter, 10), Cells(Counter, Periode + 10)).Interior.ColorIndex = 43
ws4.Activate
Range(Cells(2, 1), Cells(2, Periode + 1)).Value = 1
ws3.Activate
End If
If AnkomstDok >= PeriodeStart And AnkomstDok <= PeriodeSlut Then 'Tjekker om ankomsten ligger inden for kalenderperioden
If PeriodeSlut <= AfgangDok Then
PeriodeDokSlut = Periode
ElseIf PeriodeSlut > AfgangDok Then
PeriodeDokSlut = ws1.Cells(j, 9) - PeriodeStart
End If
ws3.Range(Cells(Counter, ((AnkomstDok - PeriodeStart) + 10)), Cells(Counter, PeriodeDokSlut + 10)).Interior.ColorIndex = 43
ws4.Activate
ws4.Range(Cells(2, ((AnkomstDok - PeriodeStart) + 1)), Cells(2, PeriodeDokSlut + 1)).Value = 1
ws3.Activate
End If
If AnkomstDok < PeriodeStart And AfgangDok <= PeriodeSlut Then
Range(Cells(Counter, 10), Cells(Counter, (AfgangDok - PeriodeStart) + 10)).Interior.ColorIndex = 43
ws4.Activate
Range(Cells(2, 1), Cells(2, (AfgangDok - PeriodeStart) + 1)).Value = 1
ws3.Activate
End If
End If
Counter = Counter + 3
ElseIf AfgangVaerft >= PeriodeStart And AfgangVaerft <= PeriodeSlut And AnkomstVaerft < PeriodeStart And Dok = "Bedding" Then
ws3.Range(Cells(Counter - 1, 1), Cells(Counter + 1, 1)).Merge
ws3.Range(Cells(Counter - 1, 2), Cells(Counter + 1, 2)).Merge
ws3.Range(Cells(Counter - 1, 3), Cells(Counter + 1, 3)).Merge
ws3.Range(Cells(Counter - 1, 4), Cells(Counter + 1, 4)).Merge
ws3.Range(Cells(Counter - 1, 5), Cells(Counter + 1, 5)).Merge
ws3.Range(Cells(Counter - 1, 6), Cells(Counter + 1, 6)).Merge
ws3.Range(Cells(Counter - 1, 7), Cells(Counter + 1, 7)).Merge
ws3.Range(Cells(Counter - 1, 8), Cells(Counter + 1, 8)).Merge
ws3.Cells(Counter - 1, 1).Value = ws1.Cells(j, 1).Value 'Overfører værdier fra sheet Indtastningsark til Sheet Vis_Oversigt
ws3.Cells(Counter - 1, 2).Value = ws1.Cells(j, 2).Value
ws3.Cells(Counter - 1, 3).Value = ws1.Cells(j, 3).Value
ws3.Cells(Counter - 1, 4).Value = ws1.Cells(j, 4).Value
ws3.Cells(Counter - 1, 5).Value = ws1.Cells(j, 7).Value
ws3.Cells(Counter - 1, 7).Value = ws1.Cells(j, 5).Value
ws3.Cells(Counter - 1, 8).Value = ws1.Cells(j, 6).Value
Range(Cells(Counter, 10), Cells(Counter, (AfgangVaerft - PeriodeStart) + 10)).Interior.ColorIndex = 5
If AnkomstDok <> "00:00:00" And AfgangDok <> "00:00:00" Then 'Tjekker om skibet er sat til at skulle i dok
If PeriodeStart >= AnkomstDok And AfgangDok >= PeriodeStart Then 'Tjekker om kalenderperioden optræder i værftsperioden
Range(Cells(Counter, 10), Cells(Counter, (AfgangDok - PeriodeStart) + 10)).Interior.ColorIndex = 43
ws4.Activate
Range(Cells(2, 1), Cells(2, ((AfgangDok - PeriodeStart) + 1))).Value = 1
ws3.Activate
End If
If AnkomstDok >= PeriodeStart Then 'Tjekker om ankomsten ligger inden for kalenderperioden
ws3.Range(Cells(Counter, ((AnkomstDok - PeriodeStart) + 10)), Cells(Counter, (AfgangDok - PeriodeStart) + 10)).Interior.ColorIndex = 43
ws4.Activate
Range(Cells(2, ((AnkomstDok - PeriodeStart) + 1)), Cells(2, (AfgangDok - PeriodeStart) + 1)).Value = 1
ws3.Activate
End If
If AnkomstDok <= PeriodeStart And AfgangDok > PeriodeStart Then
Range(Cells(Counter, 10), Cells(Counter, (AfgangDok - PeriodeStart) + 10)).Interior.ColorIndex = 43
ws4.Activate
Range(Cells(2, 1), Cells(2, (AfgangDok - PeriodeStart) + 1)).Value = 1
ws3.Activate
End If
End If
Counter = Counter + 3
End If
Next j
End Sub
