Ændre en eksisterende kode
Jeg har en makro der henter nogle data fra ark1 og indsætter det i ark2.Tekster og tal bliver vist lidt mere visuelt i ark2 end i ark1.
Hvis jeg så retter i data i nogle specifikke kolonner i ark2 rettes/indsættes dataene i ark1 igen.
Men der er nogle rettelser som jeg gerne vil have lavet, men kan ikke selv gennemskue hvordan. Jeg har forsøgt selv men er ikke kommet helt i mål.
Jeg sender gerne en fil med de 2 ark, så tingene bliver mere overskuelige.
Sub opdaterkoder()
Application.ScreenUpdating = False
With Worksheets("konto")
Start = 1
Slut = .Range("A65536").End(xlUp).Row
For I = 2 To Worksheets("oversigt1").Range("C65536").End(xlUp).Row
If Not IsEmpty(Cells(I, 1).Value) Then
For J = Start To Slut
If Cells(I, 1).Value = .Cells(J, 1).Value Then
If Cells(I, 9).Value <> .Cells(J, 7).Value Then
.Cells(J, 7) = Cells(I, 9)
End If
Start = J
Exit For
End If
Next J
End If
Next I
End With
' herefter hentes de opdaterede overskrifter ind i arket igen
Dim Poster()
With Worksheets("konto")
Data = .Range("A5:O" & .Range("B7000").End(xlUp).Row + 1)
End With
With Worksheets("oversigt1")
On Error Resume Next
.Range("A5:O" & .Range("A65536").End(xlUp)).ClearContents
Rows.RowHeight = 12.75
Cells.PageBreak = xlPageBreakNone
End With
ReDim Poster(UBound(Data), 14)
Poster(K, 1) = "Drift"
K = K + 1
For J = 1 To UBound(Data)
If Data(J, 2) = UCase("BALANCE IALT") Then
Poster(K, 1) = "I alt"
Poster(K, 4) = Totaliår
Poster(K, 6) = Totalsidsteår
K = K + 2
Poster(K, 1) = "Afstemning"
Poster(K, 4) = AfstemningÅr1 + Totaliår
Poster(K, 6) = AfstemningÅr2 + Totalsidsteår
Exit For
End If
If Data(J, 2) = UCase("AKTIVER:") Then
Poster(K, 1) = "I alt"
Poster(K, 4) = Totaliår
Poster(K, 6) = Totalsidsteår
K = K + 2
Poster(K, 1) = "Aktiver"
K = K + 1
AfstemningÅr1 = AfstemningÅr1 + Totaliår
AfstemningÅr2 = AfstemningÅr2 + Totalsidsteår
Totaliår = 0: Totalsidsteår = 0
End If
If Data(J, 2) = UCase("GÆLD OG EGENKAPITAL:") Then
Poster(K, 1) = "I alt"
Poster(K, 4) = Totaliår
Poster(K, 6) = Totalsidsteår
K = K + 2
Poster(K, 1) = "Passiver"
K = K + 1
AfstemningÅr1 = AfstemningÅr1 + Totaliår
AfstemningÅr2 = AfstemningÅr2 + Totalsidsteår
Totaliår = 0: Totalsidsteår = 0
End If
If IsNumeric(Data(J, 3)) Or IsNumeric(Data(J, 5)) Then
If Data(J, 3) <> 0 Or Data(J, 5) <> 0 Then
If Data(J, 7) <> Poster(K - 1, 8) And Poster(K - 1, 2) <> "" Then
K = K + 1
End If
Poster(K, 0) = Data(J, 1)
Poster(K, 2) = Data(J, 2)
Poster(K, 4) = Data(J, 3)
Poster(K, 6) = Data(J, 5)
Poster(K, 8) = Data(J, 7)
Poster(K, 10) = Data(J, 8)
Poster(K, 11) = Data(J, 10)
Poster(K, 12) = Data(J, 11)
Poster(K, 13) = Data(J, 13)
Poster(K, 14) = Data(J, 14)
K = K + 1
Totaliår = Totaliår + Data(J, 3)
Totalsidsteår = Totalsidsteår + Data(J, 5)
End If
End If
Next J
Worksheets("oversigt1").Range("A5").Resize(UBound(Poster), 15) = Poster
For I = 2 To Worksheets("oversigt1").Range("A65536").End(xlUp).Row
If Cells(I, 1) = "" And Cells(I - 1, 1) <> "" And Cells(I + 1, 1) <> "" Then
Rows(I).RowHeight = 7
End If
Next I
Application.ScreenUpdating = False
With Worksheets("konto")
Start = 1
Slut = .Range("A65536").End(xlUp).Row
For I = 2 To Worksheets("oversigt1").Range("C65536").End(xlUp).Row
If Not IsEmpty(Cells(I, 1).Value) Then
For J = Start To Slut
If Cells(I, 1).Value = .Cells(J, 1).Value Then
If Cells(I, 9).Value <> .Cells(J, 7).Value Then
.Cells(J, 7) = Cells(I, 9)
End If
Start = J
Exit For
End If
Next J
End If
Next I
End With
End Sub
