Introduction
I have a spreadsheet in Excel, looking like this:
I collect and sort the values in the column labelled "Antal dagar venting", based on the values in the columns "Nivå 1" and "Nivå 2".
My current code for collecting this data is:
In a class-module:
Option Explicit
Private pAntalDagar As Long
Private pDelårsaker As Dictionary
' Tid
Public Property Get AntalDagar() As Long
AntalDagar = pAntalDagar
End Property
Public Property Let AntalDagar(Value As Long)
pAntalDagar = Value
End Property
' Delårsaker
Public Property Get Delårsaker() As Dictionary
Set Delårsaker = pDelårsaker
End Property
Public Property Set Delårsaker(Value As Dictionary)
Set pDelårsaker = Value
End Property
In a regular module:
Option Explicit
Sub samle_data(fra As Date, til As Date)
Dim c As Range
Dim tid As Long
Dim hovudårsak As String, delårsak As String, feil_melding As String
Dim v As Variant
Dim hovudårsaker As clsHovudårsak
Dim dictHovudårsaker As Dictionary, dictDelårsaker As Dictionary, dictManglandeVerdier As Dictionary
Set hovudårsaker = New clsHovudårsak
Set dictHovudårsaker = New Dictionary: Set dictManglandeVerdier = New Dictionary
For Each c In Range(Registrering.Range("A3"), Registrering.Range("A1048576").End(xlUp))
If IsNumeric(c.Offset(0, 6).Value2) Then
tid = CLng(c.Offset(0, 6).Value2)
Else
tid = 0
End If
If tid < 0 Then
feil_melding = "Ventetida er mindre enn null dagar"
dictManglandeVerdier.Add Item:=feil_melding, Key:=c.Offset(0, 6).AddressLocal
ElseIf Len(c.Offset(0, 1).Value2) = 0 Then
feil_melding = "Det manglar hovudårsak"
dictManglandeVerdier.Add Item:=feil_melding, Key:=c.Offset(0, 6).AddressLocal
ElseIf Len(c.Offset(0, 2).Value2) = 0 Then
feil_melding = "Det manglar delårsak"
dictManglandeVerdier.Add Item:=feil_melding, Key:=c.Offset(0, 6).AddressLocal
ElseIf Len(c.Offset(0, 5).Value2) <> 0 Then
hovudårsak = CStr(c.Offset(0, 1).Value2)
delårsak = CStr(c.Offset(0, 2).Value2)
If dictHovudårsaker.Exists(hovudårsak) Then
Set hovudårsaker = dictHovudårsaker(hovudårsak)
hovudårsaker.AntalDagar = hovudårsaker.AntalDagar + tid
Set dictDelårsaker = hovudårsaker.Delårsaker
If dictDelårsaker.Exists(delårsak) Then
dictDelårsaker(delårsak) = dictDelårsaker(delårsak) + tid
Else
dictDelårsaker.Add Item:=tid, Key:=delårsak
hovudårsaker.AntalDagar = tid
Set hovudårsaker.Delårsaker = dictDelårsaker
End If
Else
Set hovudårsaker = New clsHovudårsak
Set dictDelårsaker = New Dictionary
hovudårsaker.AntalDagar = tid
Set hovudårsaker.Delårsaker = dictDelårsaker
dictDelårsaker.Add Key:=delårsak, Item:=tid
dictHovudårsaker.Add Key:=hovudårsak, Item:=hovudårsaker
End If
End If
Next c
For Each v In dictManglandeVerdier
feil_melding = CStr(dictManglandeVerdier(v)) & " i celle " & CStr(v) & " i registreringsarket." & vbCrLf _
& vbCrLf & "Data frå denne linja vil ikkje verte teke med i grafane."
MsgBox Prompt:=feil_melding, Buttons:=vbExclamation, Title:="Mangler data"
Next v
Call skriv_data(dictHovudårsaker)
End Sub
Sub skriv_data(dictHovudårsaker As Dictionary)
Dim hovudårsak As Variant, delårsak As Variant
Dim hovudårsaker As clsHovudårsak
Dim dictDelårsaker As Dictionary
For Each hovudårsak In dictHovudårsaker
Set hovudårsaker = dictHovudårsaker(hovudårsak)
Set dictDelårsaker = hovudårsaker.Delårsaker
'Debug.Print "Hovudårsak: " & hovudårsak & " - Tid: " & hovudårsaker.AntalDagar
For Each delårsak In dictDelårsaker
'Debug.Print "Delårsak: " & delårsak & " - Tid: " & dictDelårsaker(delårsak)
Next delårsak
Next hovudårsak
End Sub
Sub test()
Call samle_data(#1/1/2010#, #12/31/2015#)
End Sub
The problem
I think the loop described in the procedure skriv_data
shows the output I want pretty well. The output for the sample workbook I posted at the top would be something like this:
Now, I believe the code works as it should, or at least I haven't found any bugs in it yet. However I feel it is rather convoluted, so I was wondering if someone here has any suggestions for how I can improve it? I'd like to avoid using Pivot-tables.