Jeg har dog et par yderligere ting som driller, og håber derfor at du vil ofre lidt mere tid på at hjælpe.
Indledningsvis, så har jeg ændret lidt i den formel du lavede, således. at "Beløb" = Det fulde beløb. Dvs. det er ikke bare ændringen (jeg har sat en note i VBA koden, så du kan se hvad jeg mener). Årsagen er, at jeg egentlig regnede med, at det var tilstrækkeligt at se det overordende resultat.
Mit problem er nu, at jeg har behov for også at se hvor ændringen har været. Således kunne jeg godt tænke mig, at kolonne O ligges under "beløb" i personale (Det gør den ved den ændring jeg har lavet i koden), men yderligere, at kolonne N bliver lagt i kolonne V "Ændring" i personale
Jeg har dog I den forbindelse yderligere et problem, nemlig at konto 210100 løn består af tre elementer, nemlig grundløn, resultatløn og tillæg - men de ligger alle på samme overordnede konto. Jeg ville jo egentlig gerne se hvordan fordelingen mellem de tre konti er, men jeg kan ikke ødelægge strukturen i rækkerne under "personale". Er det muligt, at der ud for konto 210100 i personale arket, bliver specificeret, eks. i kolonne X:Z, hvordan lønne er bygget op.
Ekspmelvis: ALM har en løn org. løn på 1125. 1000 er grundløn, 100 er resultatløn og 25 er tillæg. Nu får hun 1000 kr. mere i grundløn 100 mere i reultatløn og 10 kr yderligere i tillæg. Kan macroen så ligge de ændrede beløb ud i hhv. x, y, Z kolonnen ud for 210100? Jeg har prøvet at illustrere i filen.
Dim kontonr As Long, initialer As String, beløb As Long, ændring As Long Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$M$12:$O$12" Then svar = MsgBox("Opdater ændringer?", vbYesNo) If svar = 6 Then Set arkPersonale = ActiveWorkbook.Sheets("Personale")
findEvtÆndringer End If End If End Sub Private Sub findEvtÆndringer() Dim celle, adr As String, pRæk As Long
Application.ScreenUpdating = False
For Each celle In Range(ændringsOmråde).Cells If celle.Interior.ColorIndex = detailFarve And _ IsNumeric(celle.Value) = True And celle.Value <> "" Then adr = celle.Address kontonr = Range(adr).Offset(0, 2) initialer = Range("B3")
Rem Jeg har ændret her, så beløb hedder: beløb = Range (adr).Offset (0,1) beløb = Range(adr).Offset(0, 1) ændring = Range(adr)
pRæk = findRække(initialer, kontonr)
If pRæk > 0 Then opdaterPersonaleÆndring pRæk, beløb, ændring Rem er det lønkonto If kontonr = lønKontoNr Then opdaterLønkonto pRæk, Range("O16"), Range("O17"), Range("O18") End If Else MsgBox ("Række i Personale ej fundet vedr.: " & initialer & "/" & CStr(kontonr)) End If End If Next celle
arkPersonale.Activate arkPersonale.Columns.AutoFit Application.ScreenUpdating = True End Sub Private Function findRække(initialer, kontonr) Dim ræk As Long, række As String
With arkPersonale For ræk = 2 To 65126 række = ræk If .Range("A" & række) <> "" Then If .Range("B" & række) = initialer And .Range("D" & række) = kontonr Then findRække = ræk Exit Function End If Else Exit For End If Next ræk End With
findRække = 0 End Function Private Sub opdaterLønkonto(ræk, grundLøn, resultatLøn, tilLæg) Dim række As String række = ræk With arkPersonale .Range("X" & række) = grundLøn .Range("Y" & række) = resultatLøn .Range("Z" & række) = tilLæg End With End Sub Private Sub opdaterPersonaleÆndring(ræk, beløb, ændring) Dim celle, adr As String, række As String række = ræk With arkPersonale For Each celle In .Range("A" & række & ":" & "E" & række).Cells adr = celle.Address .Range(adr).Offset(0, 13) = .Range(adr).Value Next
For Each celle In .Range("G" & række & ":" & "H" & række).Cells adr = celle.Address .Range(adr).Offset(0, 13) = .Range(adr).Value Next
Rem test beløb If beløb <> 0 Then .Range("S" & række) = .Range("S" & række) + beløb .Range("V" & række) = .Range("V" & række) + ændring End If End With End Sub Private Function findFørsteRække(initialer) Dim ræk As Long, række As String
With arkPersonale For ræk = 2 To 65126 række = ræk If .Range("A" & række) <> "" Then If .Range("B" & række) = initialer Then findFørsteRække = ræk Exit Function End If Else Exit For End If Next ræk End With
findFørsteRække = 0 End Function Private Sub opdaterPersonaleIngenÆndringer(initialer, ræk1) Dim celle, adr As String, række As String
For ræk = ræk1 To 65126 række = ræk With arkPersonale If .Range("B" & række) = initialer Then Rem udfyld kun ikke allerede udfyldte rækker If .Range("N" & række) = "" Then For Each celle In .Range("A" & række & ":" & "H" & række).Cells adr = celle.Address .Range(adr).Offset(0, 13) = .Range(adr).Value Next End If Else Exit For End If End With Next ræk End Sub
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
