Jag behöver hjälp med min kod då jag lyckas inte få färgerna i slutet. Uppskattar om någon kan lösa problemet.
Koden itererar igenom varje rad i det angivna datoområdet.
För varje rad kontrollerar den om nyckelorden "betalningsmottagare" och "avsändare" finns i kolumn G (Beskrivning).
Om nyckelorden hittas hämtar koden avsändaren, betalningsmottagaren och det motsvarande beloppet (debiterat eller krediterat).
Därefter söker den efter en matchande rad inom datoområdet där betalningsmottagaren och avsändaren är utbytta.
Om en match hittas jämför koden det debiterade och krediterade beloppet.
Om beloppen matchar färgar den debit- eller kreditcellen i den aktuella raden grönt och den motsvarande cellen i den andra raden också grönt.
Om beloppen inte matchar färgar den debit- eller kreditcellen i den aktuella raden orange och den motsvarande cellen i den andra raden också orange.
Detta framhäver visuellt matchningar och skillnader mellan de debiterade och krediterade beloppen i Excel-filen.
Här är de kolumner som används i koden:
Kolumn G: Beskrivning (för att söka efter nyckelord)
Kolumn A: Avsändare
Kolumn D: Betalningsmottagare
Kolumn L: Debitbelopp
Kolumn M: Kreditbelopp
Här är koden
Sub BalansTredjepartsKonton()
Dim rng As Range
Dim cell As Range
Dim mottagare As String
Dim avsändare As String
Dim belopp As Double
Dim motsvarandeCell As Range
' Fråga användaren att välja området med data att kontrollera
On Error Resume Next
Set rng = Application.InputBox("Välj området med data att kontrollera:", Type:=8)
On Error GoTo 0
' Kontrollera om användaren avbröt valet
If rng Is Nothing Then
MsgBox "Åtgärden avbruten."
Exit Sub
End If
' Iterera genom varje cell i det angivna området
For Each cell In rng
' Hämta värdet i cellen i kolumn G (Beskrivning)
Dim beskrivning As String
beskrivning = cell.Offset(0, 6).Value
' Sök efter nyckelord i beskrivningen
If InStr(1, beskrivning, "mottagare", vbTextCompare) > 0 And InStr(1, beskrivning, "avsändare", vbTextCompare) > 0 Then
' Hämta avsändare och mottagare
avsändare = cell.Offset(0, -6).Value
mottagare = cell.Offset(0, -9).Value
' Sök efter motsvarande belopp (debiterat eller krediterat)
For Each motsvarandeCell In rng
If motsvarandeCell.Value = mottagare And motsvarandeCell.Offset(0, -6).Value = avsändare Then
' Kontrollera om beloppet finns i debetkolumnen (L)
If Not IsEmpty(motsvarandeCell.Offset(0, -2).Value) Then
belopp = motsvarandeCell.Offset(0, -2).Value ' Hittat debiterat belopp
Else
belopp = motsvarandeCell.Offset(0, -1).Value ' Hittat krediterat belopp
End If
Exit For
End If
Next motsvarandeCell
' Kontrollera om det debiterade beloppet matchar det krediterade beloppet
If Abs(belopp - cell.Offset(0, 12).Value) < 0.01 Then
' Beloppet är balanserat, färga debetcellen i grönt
motsvarandeCell.Offset(0, -2).Interior.Color = RGB(0, 255, 0) ' Grönt
' Färga kreditcellen i grönt
cell.Offset(0, 12).Interior.Color = RGB(0, 255, 0) ' Grönt
Else
' Det finns en skillnad, färga debetcellen i orange
motsvarandeCell.Offset(0, -2).Interior.Color = RGB(255, 165, 0) ' Orange
' Färga kreditcellen i orange
cell.Offset(0, 12).Interior.Color = RGB(255, 165, 0) ' Orange
End If
End If
Next cell
End Sub