[EXCEL] kolommen in een tabels kippen

Pagina: 1
Acties:

Vraag


Acties:
  • 0 Henk 'm!

  • waztone
  • Registratie: November 2001
  • Laatst online: 26-06 05:42

waztone

de enige echte

Topicstarter
Mijn vraag
Ik heb een excel bestand met meerdere (soortgelijke) sheets. Elke sheet heeft (bijna dezelfde) tabellen van 14 kolommen.
Bij het invoeren van informatie in die tabellen, gebruik ik de TAB toets om te wisselen tussen de verschillende kolommen. Maar enkele van die kolommen bevatten berekende resultaten en die hoef ik dan dus ook niet te wijzigen. Ik wil dus sommige kolommen overslaan bij het tabben.

Relevante software en hardware die ik gebruik
Excel 2021

Wat ik al gevonden of geprobeerd heb
Het beveiligen van cellen werkt niet optimaal, want dan moet ik te vaak de beveiliging van het bestand opheffen om wijzigingen te doen. Ook wordt er dan niet automatisch een nieuwe rij toegevoegd als je het einde van de tabel hebt bereikt.

Toen kwam ik een stukje VBA code tegen die het skippen van kolommen mogelijk zou maken. Dit werkte echter alleen bij elke volgende kolom. [zie https://www.extendoffice....p-cells-when-tabbing.html]
In mijn geval komen er ook een drietal kolommen achter elkaar die geskipt moeten worden. En dit werkte niet met deze code.

Toen heb ik zelf wat VBA geprobeerd.
Ik wil dus dat kolom 5,6,7, 10, 13 en 14 worden geskipt. Kolom 14 is tevens de laatste kolom in de tabel. Dus als ik in kolom 12 zit en ik druk op TAB, dan moet hij naar de eerste cel op de volgende rij gaan. En als er geen volgende rij is, dan moet hij een nieuwe aanmaken. Extra bonus zou zijn als SHIFT-TAB ook zou werken om terug te skippen in kolommen. Het stukje code wat ik nu heb, doet dat iig niet.

De code die ik nu heb is:
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub Worksheet_SelectionChange (ByVal Target as Range)
   Dim ColInt as Integer
   Dim OffSetInt as Integer

   ColInt = ActiveCell.Column
   If ColInt = 5 or ColInt = 6 or ColInt = 7 Then
      OffSetInt = 8 - ColInt
      Target.Offset(,OffSetInt).Select
   End If
   'bovenstaande werkt. Kolom 5, 6 & 7 worden geskipt en kolom 8 wordt geselecteerd.

   If ColInt = 10 Then
      Target.Offset(,1).Select
   End If

   If ColInt = 13 Then
      'hier moet ie dus naar de eerste kolom op de volgende rij gaan en als er geen volgende rij is, er een maken.


Dit werkt wel iets, maar niet optimaal.

Heeft iemand suggesties?

All is fair in God of War

Beste antwoord (via waztone op 05-01-2023 18:48)


  • dix-neuf
  • Registratie: Juli 2018
  • Niet online
- Rechtsklik links-onderaan op de tab met de naam van het blad waarin de aangepaste werking van de tabtoets moet functioneren en kies in het verschijnende menu: "Programmacode weergeven".
- Plaats aan de rechterkant deze 2 macro's.
code:
1
2
3
4
5
6
7
8
9
Private Sub Worksheet_Activate()
Application.OnKey "{TAB}", "Tabintercept"
Application.OnKey "+{TAB}", "ReverseTabintercept"
End Sub

Private Sub Worksheet_Deactivate()
Application.OnKey "{TAB}"
Application.OnKey "+{TAB}"
End Sub

Plaats onderstaande 2 macro's in een module (als er in de vba-editor nog geen module bestaat, kies dan eerst bovenaan in de vba-editor: "Invoegen" - "Module").
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Public Sub Tabintercept()
Dim rc as integer
With ActiveCell
Select Case .Column()
Case 4
.Offset(, 4).Activate
Case 9
.Offset(, 2).Activate
Case 12
.Offset(1, -11).Activate
rc = Sheets("Blad2").ListObjects("Tabel1").Range.Rows.Count
If rc = ActiveCell.Row - 1 Then
Rows(rc).Insert Shift:=xlDown
End If
Case Else
.Offset(, 1).Activate
End Select
End With
End Sub

Public Sub ReverseTabintercept()
With ActiveCell
Select Case .Column()
Case 15
.Offset(, -3).Activate
Case 11
.Offset(, -2).Activate
Case 8
.Offset(, -4).Activate
Case Else
If .Column() > 1 Then
.Offset(, -1).Activate
End If
End Select
End With
End Sub

- Sluit de vba-editor door op het kruisje rechtsboven te klikken.
- Sla het bestand op als *.xlsm-file, d.w.z.: als Excelfile met macro's.
- Voer een test uit door in het betreffende blad op resp. de TAB- en Shift-Tab-toets te drukken.

[ Voor 6% gewijzigd door dix-neuf op 03-01-2023 22:58 ]

Alle reacties


Acties:
  • Beste antwoord
  • 0 Henk 'm!

  • dix-neuf
  • Registratie: Juli 2018
  • Niet online
- Rechtsklik links-onderaan op de tab met de naam van het blad waarin de aangepaste werking van de tabtoets moet functioneren en kies in het verschijnende menu: "Programmacode weergeven".
- Plaats aan de rechterkant deze 2 macro's.
code:
1
2
3
4
5
6
7
8
9
Private Sub Worksheet_Activate()
Application.OnKey "{TAB}", "Tabintercept"
Application.OnKey "+{TAB}", "ReverseTabintercept"
End Sub

Private Sub Worksheet_Deactivate()
Application.OnKey "{TAB}"
Application.OnKey "+{TAB}"
End Sub

Plaats onderstaande 2 macro's in een module (als er in de vba-editor nog geen module bestaat, kies dan eerst bovenaan in de vba-editor: "Invoegen" - "Module").
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Public Sub Tabintercept()
Dim rc as integer
With ActiveCell
Select Case .Column()
Case 4
.Offset(, 4).Activate
Case 9
.Offset(, 2).Activate
Case 12
.Offset(1, -11).Activate
rc = Sheets("Blad2").ListObjects("Tabel1").Range.Rows.Count
If rc = ActiveCell.Row - 1 Then
Rows(rc).Insert Shift:=xlDown
End If
Case Else
.Offset(, 1).Activate
End Select
End With
End Sub

Public Sub ReverseTabintercept()
With ActiveCell
Select Case .Column()
Case 15
.Offset(, -3).Activate
Case 11
.Offset(, -2).Activate
Case 8
.Offset(, -4).Activate
Case Else
If .Column() > 1 Then
.Offset(, -1).Activate
End If
End Select
End With
End Sub

- Sluit de vba-editor door op het kruisje rechtsboven te klikken.
- Sla het bestand op als *.xlsm-file, d.w.z.: als Excelfile met macro's.
- Voer een test uit door in het betreffende blad op resp. de TAB- en Shift-Tab-toets te drukken.

[ Voor 6% gewijzigd door dix-neuf op 03-01-2023 22:58 ]


Acties:
  • 0 Henk 'm!

  • dix-neuf
  • Registratie: Juli 2018
  • Niet online
De macro "Public Sub Tabintercept()" is zodanig aangepast dat in de tabel - indien nodig - een nieuwe rij wordt aangemaakt (aanname: de naam van de tabel is Tabel1 en het blad waarin die tabel staat is "Blad2").

[ Voor 12% gewijzigd door dix-neuf op 04-01-2023 08:02 ]


Acties:
  • 0 Henk 'm!

  • waztone
  • Registratie: November 2001
  • Laatst online: 26-06 05:42

waztone

de enige echte

Topicstarter
Thnx! Hier kan ik zeker wat mee. OnKey kende ik nog niet. Hartstikke bedankt! Ik laat weten hoe het is geworden.

All is fair in God of War


Acties:
  • 0 Henk 'm!

  • waztone
  • Registratie: November 2001
  • Laatst online: 26-06 05:42

waztone

de enige echte

Topicstarter
OK, zo is ie geworden:

Op het werkblad;
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Test of cel in een tabel zit
    TableName = Empty
    trc = Empty
    crc = Empty
    On Error Resume Next
    
    Set lo = Target.ListObject
    trc = lo.ListRows.Count
    crc = Target.Row - lo.DataBodyRange.Rows(0).Row
    TableName = lo.Name
    On Error GoTo 0
    
    'Uitkomst van test
    If TableName <> "" Then
        'Cel zit in een tabel    
        Application.OnKey "{TAB}", "SkipTab"
        Application.OnKey "+{TAB}", "RevSkipTab"
      Else
        'Cel zit niet in een tabel
        Application.OnKey "{TAB}"
        Application.OnKey "+{TAB}"
    End If
End Sub


En in de module:
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Public TableName As String
Public trc As Integer
Public crc As Integer
Public lo As ListObject

Public Sub SkipTab()
    With ActiveCell
    Select Case .Column()
    Case 4
        .Offset(, 4).Activate
    Case 9
        .Offset(, 2).Activate
    Case 12
        If crc = trc Then
        lo.ListRows.Add AlwaysInsert:=True
            .Offset(1, -11).Activate
        Else
            .Offset(1, -11).Activate
        End If
    Case Else
        .Offset(, 1).Activate
    End Select
    End With
End Sub

Public Sub RevSkipTab()
    With ActiveCell
    Select Case .Column()
    Case 15
        .Offset(, -3).Activate
    Case 11
        .Offset(, -2).Activate
    Case 8
        .Offset(, -4).Activate
    Case Else
    If .Column() > 1 Then
        .Offset(, -1).Activate
        End If
        End Select
        End With
End Sub


Zo kijkt ie of je in een tabel zit, dan werkt de aangepaste TAB functie. Als je niet in een tabel zit, dan werkt de tab gewoon.
Het enige wat ie nu nog niet doet, is "ongedaan maken" (of CTRL-Z). Dus stel ik heb per ongeluk iets te fanatiek getabt en er staat een extra lege rij onder m'n tabel, dan ziet ie dat niet als een actie die terug te draaien is.
Maar voor de rest werkt ie precies zoals ik het wou hebben.

All is fair in God of War