4
\$\begingroup\$

Introduction

I have a spreadsheet in Excel, looking like this: enter image description here 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:

enter image description here

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.

\$\endgroup\$
0

1 Answer 1

1
\$\begingroup\$

Len(rng.Value2) = 0 is not as efficient as IsEmpty(rng). Not sure if that function is the same in every language. See https://stackoverflow.com/questions/13360651/excel-how-to-check-if-a-cell-is-empty-with-vba

I don't think any of your CStr are necessary.

It is confusing to have variables with similar names -- hovudårsak and hovudårsaker for instance.

Why did you make it a class module with properties? It doesn't seem to benefit at all by that design choice over a Type.

\$\endgroup\$
3
  • \$\begingroup\$ Using Len instead of IsEmpty catches different stuff, as (partly) pointed out in the question the one you linked to is marked as a duplicate of. The difference in performance seems to be negligible too, according to my simple test. Totally agree on the naming of variables, gonna look into that. The reason for making a class instead of a type is because I may be doing some handling of the values stored in it later on, although I for now have focused on just collecting the data. Could you expand on why a type would be better? \$\endgroup\$
    – eirikdaude
    Commented Oct 1, 2015 at 6:16
  • \$\begingroup\$ Not better per se, but shorter code. Your reason is good enough to keep it a Class. I'll see what else I can observe in your code. \$\endgroup\$
    – Snowbody
    Commented Oct 2, 2015 at 3:30
  • \$\begingroup\$ Thanks - I'd be especially interested if you can see any better way to structure the dictionaries and / or types / classes to make the code easier to read. \$\endgroup\$
    – eirikdaude
    Commented Oct 2, 2015 at 5:49

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.