Kontoanalys

Detta tips visar hur vi kan jämföra textsträngar med varandra och vid överensstämmelse kopiera relevanta rader från ett arbetsblad till ett annat arbetsblad.

Det kan vara av stort intresse vid t ex kontoanalyser och för de transaktioner som har registrerats på kontot.

Exemplet har sin utgångspunkt i följande uppställning:

 

Problemet i exemplet är att identifiera de rader som har samma värden kolumnområdet C:F.

1:a radens värden ska jämföras med 2:a radens värden och därefter upprepas denna process med 3:e och 4:e radens värden osv.

För att underlätta jämförelsen sätts varje rads värden ihop till en textsträng i en annan kolumn och utifrån dessa strängvärden sker  jämförelsen. Överensstämmer värdena med varandra ska respektive rads värden kopieras över till ett annat blad.

Option Explicit

Sub Konto_Analys()
'© 2001 Alla rättigheter XL-Dennis
Dim wsBlad1 As Worksheet, wsBlad2 As Worksheet
Dim rnOmrade As Range, rnCell As Range
Dim stTal As String
Dim lnNastaRad As Long
Dim iRader As Integer, i As Integer, j As Integer

Set wsBlad1 = ThisWorkbook.Worksheets("Blad1")
Set wsBlad2 = ThisWorkbook.Worksheets("Blad2")
Set rnOmrade = wsBlad1.Range(Range("C2"), Range("F65536").End(xlUp))

Application.ScreenUpdating = False

iRader = rnOmrade.Rows.Count

On Error Resume Next

'Här sätts jämförelsevärdena ihop i kolumn J
For i = 1 To iRader
        If IsEmpty(rnOmrade(i, 2)) Then
           stTal = CStr(rnOmrade(i, 1).Value & rnOmrade(i, 4).Value & _
           rnOmrade(i, 3).Value)
        Else
           For j = 1 To 4
              If Application.WorksheetFunction.IsText(rnOmrade(i, j).Value) = True  _
              Then
                   stTal = stTal & rnOmrade(i, j).Value
              ElseIf rnOmrade(i, j).Value < 0 Then
                   stTal = stTal & CStr(Abs(rnOmrade(i, j).Value))
              Else
                   stTal = stTal & CStr(rnOmrade(i, j).Value)
              End If
           Next j
          End If
          rnOmrade(i, 4).Offset(0, 4).Value = stTal
          stTal = ""
Next i

'Här sker jämförelse mellan värdena i kolumn J,
'rad 2 jämförs med rad 3 osv.
'Är värdena lika kopieras motsvarande rader ut i Blad1
'och klistras in i Blad 2
For i = 1 To iRader
        lnNastaRad = _
        Application.WorksheetFunction.CountA(wsBlad2.Range("A:A")) + 1
        If rnOmrade(i, 4).Offset(0, 4).Value = _
        rnOmrade(i + 1, 4).Offset(0, 4).Value Then
             Range(rnOmrade(i, 1), rnOmrade(i + 1, 4)).Copy _
                 wsBlad2.Range("A" & lnNastaRad)
             i = i + 1
        End If
Next i

wsBlad2.Columns("A:D").EntireColumn.AutoFit

'Här tas jämförelsesträngarna i kolumn J bort
Range(rnOmrade(1, 4).Offset(0, 4), _
rnOmrade(iRader, 4).Offset(0, 4)).Clear

Application.ScreenUpdating = True
End Sub