25. november 2019 - 13:40 Der er 10 kommentarer og
1 løsning

VBA programmering til CRM-lignende system

Jeg har arbejdet videre på et gammel skema som indeholder VBA-programmering således at man ved at trykke på en knap kan opdatere ark 1 (Kaldet opsummering) med alle sager der har opfølgning den indeværende dag.

I første ark kaldet 'Opsummering' har jeg følgende kolonner:

A: Dato
B: Koordinator
C: Kommune
D: Sagsbehandler
E: Opgave
F: Deadline
G: Mail sendt/svar modtaget
H: Status

J: Opdater opfølgning

I andet ark kaldet 'Søborg' har jeg samme kolonner som ovenfor pånær J. Overskifterne i tabellen ligger dog fra 2. række og nedefter hvor de i første ark ligger fra 1. række.

I tredje ark kaldet 'Slagelse' har jeg samme kolonner som i 2. ark.

Er der nogle som kan hjælpe med at udvikle en VBA-programmering som gør, at jeg ved at højreklikke på feltet i Kolonne J1 kan få opdateret listen med alle sager der hvor 'Deadline' = d.d.?

På forhånd tusinde tak.
Avatar billede Jan Hansen Ekspert
25. november 2019 - 14:03 #1
1. Upload eksempel til dropbox eller lignende, det gør det lettere at give dig den rette løsning!!

2. er der nogen god grund til det skal være en vba-løsning?
Avatar billede 9kP Novice
25. november 2019 - 14:08 #2
Kan du ikke bare filtrere?
25. november 2019 - 14:22 #3
#1 Hej Jan,

Jeg har uploadet eksemplet i denne mappe på dropbox:

https://www.dropbox.com/s/eebfngmiiat8eiw/Koordinator%20deadline.xlsx?dl=0

Den eneste grund til, at jeg tænker VBA er fordi der engang var en venlig bruger herinde fra der lavede et lignende ark til mig - dog med andre kolonner og funktioner. Men løsninger som ville kunne give samme resultat er dog også helt fint.

Jeg vil dog gerne tilføje at jeg har lavet lidt rettelser i forhold til arket:

Arket 'Opsummering' skal blot opdateres med informationerne fra arket 'Søborg' og 'Slagelse' såfremt datoen i kolonne E3 i de to ark er lig med (IDAG). 

Derudover ville det være at foretrække hvis tabellen i arket 'Opsummering' kunne være sorteret på kommuner og på koordinator. 

Fx. At alle de kolonner som har Slagelse som kommune og JRB som koordinator står i rækkefølge, derefter Slagelse og KRM etc.

Arket 'Løst - ikke løst' skal ikke kunne noget. Tanken med denne fane er blot at de sager som er løst, eller ikke kan løses kan flyttes fra 'Søborg' og 'Slagelse' fanen over i dette ark. 

På forhånd tusinde tak!
25. november 2019 - 14:23 #4
#2 Hej 9kP,
Det ark jeg anvender nu er med sortering men jeg synes ikke det giver samme effektive overblik som jeg er ude efter og det skulle gerne være med til at forkorte processen.
Avatar billede 9kP Novice
25. november 2019 - 14:29 #5
så er det nemmeste vel bare du optager en makro der sorterer filtret for dig. og giv det en genvej
25. november 2019 - 14:35 #6
#2

Det ved jeg desværre heller ikke hvordan man gør.
Jeg er ikke så ferm til Excel når det kommer til hverken Makro eller VBA.
Avatar billede Jan Hansen Ekspert
25. november 2019 - 16:37 #7
skal tabellerne i Søborg og Slagelse ikke være ens? (Det er de ikke nu)
Avatar billede Jan Hansen Ekspert
25. november 2019 - 23:16 #8
26. november 2019 - 09:45 #9
#8 Hej Jan,
Tusinde tak for din hjælp!

Det er præcis den løsning jeg har brug for.
Hvis du har tid til at forklare mig hvordan du har gjort er jeg meget interesseret i at lære mere.

Jeg har markeret dit svar som løsningen, men er der mere jeg skal gøre?

Endnu engang tusinde tak - jeg er dybt taknemmelig for din hjælp.
Avatar billede Jan Hansen Ekspert
26. november 2019 - 10:24 #10
velbekomme
Avatar billede Jan Hansen Ekspert
26. november 2019 - 10:48 #11
https://www.dropbox.com/s/liwonpfdafchk0v/Koordinator%20deadline.xlsm?dl=0

Har prøvet at kommentere kode:


Option Explicit
Dim WsSø As Worksheet, WsSl As Worksheet, WsOp As Worksheet
Dim Area_1 As Range, Area_2 As Range, Area As Range
Dim Arr_1() As Variant, Arr_2() As Variant
Dim MellemArr() As Variant, NewArr() As Variant
Dim Rækker As Long, iRow As Integer, iColumn As Integer, Tæl As Integer
Dim Dato As Date

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target = Range("J1") Then ' tester om der er højreklikket på J1
        Cancel = True ' aflyser højreklikket = ingen højrekliksmenu
        MinKode
    End If
End Sub

Private Sub MinKode()
    ' de 3 ark som en variabel
    Set WsOp = Sheets("Opsummering")
    Set WsSø = Sheets("Søborg")
    Set WsSl = Sheets("Slagelse")
    ' Area_1 ogArea_2= de navngivne områder, hvilket gør det dynamisk
    Set Area_1 = WsSø.Range("Søborg")
    Set Area_2 = WsSl.Range("Slagelse")
    ' Områderne fyldes ind i array's, som arbejder meget - meget hurtigere end direkte på regnearket
    Arr_1 = Area_1
    Arr_2 = Area_2
    ' finder udaf hvormange rækker der er i de to array's
    Rækker = UBound(Arr_1, 1) + UBound(Arr_2, 1)
    Tæl = 0
    ' sætter størrelsen på flette-array'en
    ReDim MellemArr(1 To Rækker, 1 To UBound(Arr_1, 2))
    'fylder de to array's over i flette-array'et
    For iRow = 1 To UBound(Arr_1, 1)
        Tæl = Tæl + 1
        For iColumn = 1 To UBound(Arr_1, 2)
            MellemArr(Tæl, iColumn) = Arr_1(iRow, iColumn)
        Next
    Next
    For iRow = 1 To UBound(Arr_2, 1)
        Tæl = Tæl + 1
        For iColumn = 1 To UBound(Arr_2, 2)
            MellemArr(Tæl, iColumn) = Arr_2(iRow, iColumn)
        Next
    Next
    Tæl = 0
    'sætter variablen Dato til dags dato
    Dato = Format(Now, "dd-mm-yyyy")
    'tester hvormange rækker med deadline
    For iRow = 1 To UBound(MellemArr, 1)
        If MellemArr(iRow, 5) = Dato Then Tæl = Tæl + 1
    Next
    'sætter et nyt array's størrelse
    ReDim NewArr(1 To Tæl, 1 To UBound(MellemArr, 2))
    Tæl = 0
    'fylder deadline rækker over i det nye array
    For iRow = 1 To UBound(MellemArr, 1)
        If MellemArr(iRow, 5) = Dato Then
            Tæl = Tæl + 1
            For iColumn = 1 To UBound(MellemArr, 2)
                NewArr(Tæl, iColumn) = MellemArr(iRow, iColumn)
            Next
        End If
    Next
    ' renser området på opsummerings-arket før data lægges over
    Set Area = WsOp.Range("A2")
    Set Area = Range(Area, Area.End(xlDown).Offset(0, 10))
    Area.ClearContents
    ' sætter området på opsummerings-arket til sammestørrelse som NewArr
    Set Area = WsOp.Range(WsOp.Cells(2, 1), WsOp.Cells(1 + UBound(NewArr, 1), UBound(NewArr, 2)))
    ' fylder array'et over i arket
    Area = NewArr

End Sub


Jan
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
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

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