Søg
Avatar billede pejsen Nybegynder
29. oktober 2005 - 22:30 Der er 20 kommentarer og
1 løsning

VBA - Datasortering af område

Jeg har ved stor hjælp fra Kabbak fået farvelagt mine rækker efter bestemte kriterier. se detté http://www.eksperten.dk/spm/657533

Nu ønsker jeg bare at lave en Datasortering således at rækkerne samles indenfor de gruppee/kriterier, som er farvelagte efter.

Det skal fungere således:
Hvis personer i rækkerne 11-19 alle har Casen "Syg", hvis så en person i række 25 får tildelt "Syg" skal den pr automatik sortere således at den samler alle personer i rækkerne  11-20 bliver tildelt "Syg . Eller med andre ord den skal sorterer området A3:L3 til A500:L500 Stigende på Kolonne K

Jeg vil gerne have flettet en sortering ind i denne VB-kode.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("L:L")) Is Nothing Then

  Select Case UCase(Target)
        Case "FYRET"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 3
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "SYG"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 7
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "RESERVE"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 43
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "AFTEN"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 44
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "DAG"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 19
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "NAT"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 33
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "BARSEL"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 24
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "KURSUS"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 14
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 2
        Case "FERIE"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 6
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "AFSPADSERE"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 37
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "OPPASSER"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 22
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "PRINT"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 23
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 2
        Case "IT"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 39
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "SALG"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 40
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "ADMINISTRATION"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 41
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 2
        Case "PRODUKTION"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 38
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "SERVICE"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 42
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "LAGER"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 37
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1

        Case Else
            Rows(Target.Row).Interior.ColorIndex = xlNone
            Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 1
      End Select

End If
End Sub


Med venlig hilsen
Jan
Avatar billede kabbak Professor
29. oktober 2005 - 23:09 #1
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("L:L")) Is Nothing Then

  Select Case UCase(Target)
        Case "FYRET"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 3
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "SYG"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 7
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "RESERVE"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 43
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "AFTEN"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 44
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "DAG"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 19
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "NAT"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 33
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "BARSEL"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 24
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "KURSUS"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 14
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 2
        Case "FERIE"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 6
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "AFSPADSERE"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 37
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "OPPASSER"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 22
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "PRINT"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 23
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 2
        Case "IT"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 39
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "SALG"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 40
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "ADMINISTRATION"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 41
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 2
        Case "PRODUKTION"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 38
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "SERVICE"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 42
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
        Case "LAGER"
            Range("B" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 37
            Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1

        Case Else
            Rows(Target.Row).Interior.ColorIndex = xlNone
            Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 1
      End Select

  Range("A3:L500").Sort Key1:=Range("L3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub
Avatar billede kabbak Professor
29. oktober 2005 - 23:11 #2
du mener vel på L kolonnen, det er der du har syg ikke, ellers ret L3 til K3
Avatar billede kabbak Professor
29. oktober 2005 - 23:14 #3
denne linie behøves vist ikke, undtagen hvis du selv ændrer skriftfarver.

Range("B" & Target.Row & ":L" & Target.Row).Font.ColorIndex = 1
Avatar billede kabbak Professor
29. oktober 2005 - 23:15 #4
nå, ja, jeg kan se at du ændrer den nogen steder i koden, så ok
Avatar billede pejsen Nybegynder
29. oktober 2005 - 23:18 #5
Hej igen

Jeg skal lige have en sortkey 2 med fra kolonne k
Avatar billede kabbak Professor
29. oktober 2005 - 23:23 #6
Range("A3:L500").Sort Key1:=Range("L3"), Order1:=xlAscending, Key2:=Range("K4") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
Avatar billede pejsen Nybegynder
29. oktober 2005 - 23:24 #7
Jeg har et problem med koden generel når jeg indsætter en linie, så skriver den.


Runtime Error '13'

Type mismatch
Avatar billede kabbak Professor
29. oktober 2005 - 23:26 #8
smid koden herind, så ser jeg på den
Avatar billede kabbak Professor
29. oktober 2005 - 23:28 #9
nåå, du mener hvis du indsætter en række i arket ikke.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Avatar billede pejsen Nybegynder
29. oktober 2005 - 23:32 #10
Vil du ikke heller se regnearket. Jeg kan sende det til dig.

Som du kan se nederst har lavet et Auto ID-tal (Lidt a la Access).
Men det virker ikke helt efter hensigten. Og heller ikke efter datasorteringen er kommet til. Se bunden af denne kode

Private Sub CommandButton1_Click()

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M:M")) Is Nothing Then

  Select Case UCase(Target)
        Case "FYRET"
            Range("B" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 3
            Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 1
        Case "SYG"
            Range("B" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 7
            Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 1
        Case "RESERVE"
            Range("B" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 43
            Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 1
        Case "AFTEN"
            Range("B" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 44
            Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 1
        Case "DAG"
            Range("B" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 19
            Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 1
        Case "NAT"
            Range("B" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 33
        Case "BARSEL"
            Range("B" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 24
            Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 1
        Case "KURSUS"
            Range("B" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 14
            Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 2
        Case "FERIE"
            Range("B" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 6
            Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 1
        Case "AFSPADSERE"
            Range("B" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 37
            Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 1
        Case "OPPASSER"
            Range("B" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 22
            Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 1
        Case "PRINT"
        Range("B" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 23
        Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 2

        Case Else
            Rows(Target.Row).Interior.ColorIndex = xlNone
            Range("B" & Target.Row & ":M" & Target.Row).Font.ColorIndex = 1
      End Select

End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    rowoffset = -10
    Intersect(ActiveCell.EntireRow, Columns("A")).Value = ActiveCell.Row + rowoffset
End Sub
Avatar billede kabbak Professor
29. oktober 2005 - 23:51 #11
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    If Not Intersect(Target, Range("M:M")) Is Nothing Then
        If Range("A" & Target.Row).Value = "" Then
            Range("A" & Target.Row).Value = (Application.WorksheetFunction.Max(Range("A3:A500")) + 1)
        End If
    End If
End Sub

skal erstatte din Auto ID
Avatar billede kabbak Professor
29. oktober 2005 - 23:57 #12
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim Tal As Integer
    If Not Intersect(Target, Range("M3:M500")) Is Nothing Then
        If Range("A" & Target.Row).Value = "" Then
            Range("A" & Target.Row).Value = (Application.WorksheetFunction.Max(Range("A3:A500")) + 1)
        End If
    End If
End Sub


du skal nok først starte i række 3 med begge dine makroer, hvis du har overskrifter i række 1 og 2
Avatar billede pejsen Nybegynder
29. oktober 2005 - 23:59 #13
Forstår ikke helt den nye Auto ID?????????
Avatar billede kabbak Professor
30. oktober 2005 - 00:03 #14
hvis du ingen værdier har, får det første du markerer i M kolonnen nummer 1 og den næste du markerer nummer 2 osv

hvis du sletter en række bliver tallet ikke genbrugt men får værdien på den største værdi +1.

Sådan fungerer det også i Access, ingen tal genbruges i et autonummer
Avatar billede kabbak Professor
30. oktober 2005 - 00:04 #15
hvis du sletter en række bliver tallet ikke genbrugt, men den næste nye række, får værdien på den største værdi +1.
Avatar billede pejsen Nybegynder
30. oktober 2005 - 00:15 #16
Okay, men jeg har nok ikke udtrykt min tydeligt nok.
Jeg ønsker et fortløbende nr., som gerne må blive genbrugt.
Det skal faktisk bare afspejle rækketallene. Mit problemer at at jeg har lavet nogle overskrifter i række 15, 40 , 60 og 93, så de rækker skal ikke have id, I disse række står der intet i kolonne M.
Jeg bruger ID-tallet til at prioritere vores medarbejder.
en Medarbejder kan nemlig godt flyttes op i rækkerne og få en højere proritering
Avatar billede kabbak Professor
30. oktober 2005 - 00:20 #17
hvis det er værdien på rækken du vil have, så er formlen for rækken:

= række()
Avatar billede pejsen Nybegynder
30. oktober 2005 - 00:33 #18
Nej, det er et forløbende nr. startende med Nr. 1 i A11

Men der må ikke være noget i de tal hvis der ikke er en værdi i kolonne M.
A12 = 2
A13 = 3
A14 = 4
A15 = Blankt Fordi der ikke er nogen værdi i kolonne M
A16 = 5
Hvis jeg så flytter Række 16 (Idtal 5)op i række 13, skal IDtalet blive 3 og alle rækkerne under række 16 får et nyt række nr.
A16 = 5
Avatar billede pejsen Nybegynder
30. oktober 2005 - 00:34 #19
Smid lige et svar, så du kan få dine point
Avatar billede kabbak Professor
30. oktober 2005 - 00:42 #20
.
Avatar billede pejsen Nybegynder
30. oktober 2005 - 00:53 #21
Tak for hjælpen
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
Excel kurser
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig
Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel Indlæg Oprettet Seneste aktivitet
Ændre tal i en celle Af xvid i Excel 1 04/09/202616:05 04/09/202616:54
Kan Excel selv beregne alder? Af leahcim i Excel 7 31/08/202610:24 04/09/202602:08
problem med mailbesked Af Pestilensen i Excel 3 24/08/202611:16 28/08/202612:55
Sætte billeder ind i google sheets ark ud fra elev nummer Af lurup i Excel 18 17/08/202615:14 I går 22:04
Gemme største værdi Af Lemming@privat.dk i Excel 2 07/08/202622:13 08/08/202609:03
Se alle spørgsmål i kategorien Opret spørgsmål

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.

Opret Log ind

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
I dag 11:47 VB script Af Jenshentze i Word
I dag 11:21 Popup ved opstart Af mort1 i Windows
04/0918:50 Slet lokal konto Af ErikHg i Windows
04/0916:05 Ændre tal i en celle Af xvid i Excel
04/0913:47 Dette er ikke en kommerciel session i Windows 11 Af eksmojo i Windows
White papers
Flere white papers »