26. maj 2015 - 09:24 Der er 1 kommentar og
1 løsning

CRM ligende system i Excel

Hej,

Jeg har oprettet et regneark hvor jeg har ét ark pr. virksomhed.
I hvert ark er der en oversigt over hvornår der er blevet taget kontakt til virksomhedens kunder. 

På nuværende tidspunkt har jeg 12+ et opsummeringsark.

Hvert af de 12 ark ser således ud:

B2 - Dato for kontakt.
C2 - Varighed for kontakt.
D2 - Kontakt person
E2 - Kontakt oplysninger
F2 - Kontaktform
G2 - Notat
H2 - Bemærkninger
I2 - Dato for opfølgning
J2 - Opfølgningsform

Hvor informationerne står under hver kolonne ligesom en tabel

Jeg kunne godt tænke mig, at få alle oplysningerne (fra alle ark) samtalet fra kolonne D2, E2, I2 og J2 på første ark når der er =<5 dage til opfølgningsdatoen,  således at man har alle informationer arkiveret i de forskellige ark men hurtigt kan danne sig et overblik over hvornår næste samtale/møde skal afholdes.

Jeg har først at Google diverse steder og kigge på videoer på YouTube, men ser dette som en udfordring da jeg ikke helt ved hvad jeg skal lede efter.

Derfor håber jeg inderligt, at der er én derude som har mulighed for at hjælpe.

Såfremt I har ideer til en bedre måde dette kunne løses på, er I selvfølgelig velkommen til at skrive dette også.

Jeg ser frem til at høre fra Jer og på forhånd tak.
Avatar billede supertekst Ekspert
26. maj 2015 - 13:02 #1
Ved hjælp af programmering (VBA = Visual Basic for Applications - programmeringssproget i Office) kan det lade sig gøre.

Hvis du uploader / sender en model - så skal jeg skrive VBA-koden.
@-adresse under min profil.
Avatar billede supertekst Ekspert
29. maj 2015 - 09:10 #2
Option Explicit
Const opsamlingsArkNavn = "Opsummering"
Const antalDageAdvis = 5

Dim antalRækker As Integer
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim antalArk As Integer, ark As Integer, ræknr As Integer

    If Target.Address = "$H$1" Then
        Cancel = True
        Application.ScreenUpdating = False
       
        antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
Rem Slet "gl. rækker"
        If antalRækker > 1 Then
            Range("A2:F" & antalRækker).Select
            Selection.Delete
        End If
       
        ræknr = 2
        Range("A" & ræknr).Select
       
Rem Gennemløb alle ark eksl. Opsummering
        antalArk = ActiveWorkbook.Sheets.Count
       
        For ark = 1 To antalArk
            If Sheets(ark).Name <> opsamlingsArkNavn Then
                checkOpfølgning Sheets(ark).Name, ræknr
            End If
        Next ark
     
        Sheets(opsamlingsArkNavn).Activate
        Columns.AutoFit
     
        If ræknr > 2 Then
            sorterOpfølgningsDato ræknr - 1
        End If
    End If
End Sub
Private Sub checkOpfølgning(arkNavn, ræknr)
Dim opfølgningsDato As Date, ræk As Integer, diff As Integer
    ActiveWorkbook.Sheets(arkNavn).Activate
    antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
   
    For ræk = 3 To antalRækker

        If ActiveSheet.Range("I" & ræk) <> "" And IsDate(ActiveSheet.Range("I" & ræk)) = True Then
            opfølgningsDato = ActiveSheet.Range("I" & ræk)

            diff = DateDiff("d", Now, opfølgningsDato)
            If diff >= 0 And diff <= antalDageAdvis Then
                With ActiveWorkbook.Sheets(opsamlingsArkNavn)
                    .Range("A" & ræknr) = ActiveSheet.Range("A" & ræk)      'Kommune
                    .Range("B" & ræknr) = ActiveSheet.Range("D" & ræk)      'Kunde
                    .Range("C" & ræknr) = ActiveSheet.Range("E" & ræk)      'Kontaktoplysninger
                    .Range("D" & ræknr) = opfølgningsDato
                    .Range("E" & ræknr) = ActiveSheet.Range("J" & ræk)      'Opfølgningstidspunkt
                    .Range("F" & ræknr) = ActiveSheet.Range("K" & ræk)      'Opfølgningsform
                    ræknr = ræknr + 1
                End With
            End If
        End If
    Next ræk
End Sub
Private Sub sorterOpfølgningsDato(ræknr)
    Range("D2").Select
    ActiveWorkbook.Worksheets("Opsummering").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Opsummering").Sort.SortFields.Add Key:=Range( _
        "D2:D" & ræknr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Opsummering").Sort
        .SetRange Range("A1:F" & ræknr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Avatar billede Ny bruger Nybegynder

Din løsning...

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.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester