Note: The other languages of the website are Google-translated. Back to English

Hoe de tabel uitbreidbaar te houden door een tabelrij in een beschermd werkblad in Excel in te voegen?

De automatisch uitbreidende functie van de tabel gaat verloren nadat het werkblad in Excel is beveiligd. Er is bijvoorbeeld een tabel met de naam Tabel1 in uw beveiligde werkblad. Wanneer u iets typt onder de laatste rij, wordt de tabel niet automatisch uitgevouwen om de nieuwe rij op te nemen. Is er een methode om de tabel uitbreidbaar te houden door een nieuwe rij in een beschermd werkblad in te voegen? De methode in dit artikel kan u daarbij helpen.

Houd de tabel uitbreidbaar door een tabelrij in een beveiligd werkblad met VBA-code in te voegen


Houd de tabel uitbreidbaar door een tabelrij in een beveiligd werkblad met VBA-code in te voegen


Zoals onderstaand screenshot laat zien, een tabel met de naam Table1 in uw werkblad en de laatste kolom van de tabel is een formulekolom. Nu moet u het werkblad beschermen om te voorkomen dat de formulekolom verandert, maar u kunt de tabel uitbreiden door een nieuwe rij in te voegen en nieuwe gegevens toe te wijzen aan de nieuwe cellen. Ga als volgt te werk.

1. klikken Ontwikkelaar > Invoegen > Knop (formulierbeheer) om een Formulierbeheer knop in uw werkblad.

2. In het opduiken Wijs macro toe dialoogvenster, klik op de Nieuw knop.

3. In de Microsoft Visual Basic voor toepassingen -venster, kopieer en plak de onderstaande VBA-code tussen de Sub en End Sub alinea's in de Code venster.

VBA-code: houd de tabel uitbreidbaar door een tabelrij in een beveiligd werkblad in te voegen

 'Update by ExtendOffice 20220826
    Dim xRg, tableRg As Range
    Dim xRowCount As Integer
    Dim pswStr As String
    pswStr = "123"
    On Error Resume Next
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:=pswStr

    Set tableRg = ActiveSheet.ListObjects("Table4").Range
    xRowCount = tableRg.Rows.Count
    
    Set xRg = Range("Table4[[#Headers],[Total]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault

    ActiveSheet.Protect Password:=pswStr, DrawingObjects:=False, _
                    Contents:=True, Scenarios:=False, _
                    AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                    AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                    AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
                    AllowDeletingColumns:=True, AllowDeletingRows:=True, _
                    AllowSorting:=True, AllowFiltering:=True, _
                    AllowUsingPivotTables:=True
    Application.ScreenUpdating = True

Opmerkingen:

1). In de code is nummer "123" het wachtwoord dat u gebruikt om het werkblad te beschermen.
2). Wijzig de tabelnaam en de naam van de kolom met de formule die u wilt beschermen.

4. druk de anders + Q -toetsen om het venster Microsoft Visual Basic for Applications te sluiten.

5. Selecteer de cellen in de tabel waaraan u nieuwe gegevens moet toewijzen, behalve de formulekolom, en druk vervolgens op Ctrl + 1 toetsen om de te openen Cellen opmaken dialoog venster. In de Cellen opmaken dialoogvenster, schakel het vinkje uit Vergrendeld vak en klik vervolgens op het OK knop. Zie screenshot:

6. Bescherm nu uw werkblad met het wachtwoord dat u in de VBA-code hebt opgegeven.

Vanaf nu, nadat u op de knop Formulierbeheer in uw beschermde werkblad hebt geklikt, kan de tabel worden uitgevouwen door een nieuwe rij in te voegen zoals onderstaand screenshot.

Opmerking:: u kunt de tabel wijzigen, behalve de formulekolom in het beveiligde werkblad.


Gerelateerde artikelen:


De beste tools voor kantoorproductiviteit

Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%

  • visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Versleutel cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
  • Super Formula-balk (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken in gefilterd bereik...
  • Voeg cellen / rijen / kolommen samen zonder gegevens te verliezen; Gespleten cellen inhoud; Combineer dubbele rijen / kolommen... Voorkom dubbele cellen; Vergelijk Ranges...
  • Selecteer Dupliceren of Uniek Rijen; Selecteer lege rijen (alle cellen zijn leeg); Super zoeken en fuzzy zoeken in veel werkboeken; Willekeurige selectie ...
  • Exacte kopie Meerdere cellen zonder de formuleverwijzing te wijzigen; Maak automatisch verwijzingen naar meerdere bladen; Plaats kogels, Selectievakjes en meer ...
  • Extraheer tekst, Tekst toevoegen, Verwijderen op positie, Ruimte verwijderen; Paging-subtotalen maken en afdrukken; Converteren tussen celinhoud en opmerkingen...
  • Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerd sorteren per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
  • Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
  • Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2019 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Gratis proefperiode van 30 dagen met volledige functies. 60 dagen geld-terug-garantie.
kte tabblad 201905

Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

  • Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en vermindert elke dag honderden muisklikken!
officetab onderkant
Comments (14)
Nog geen beoordelingen. Beoordeel als eerste!
Deze opmerking is gemaakt door de moderator op de site
Dus ik heb dit geprobeerd, maar het voegt een nieuwe rij toe aan de onderkant van de werkmap op regel 1048576, maar mijn tabel heeft slechts ongeveer 800 records. Ik heb geen idee waarom het dit doet!
Deze opmerking is gemaakt door de moderator op de site
Hallo Brindi,
De code is bijgewerkt en het probleem is opgelost. Probeer het alstublieft en bedankt voor uw reactie.
Deze opmerking is gemaakt door de moderator op de site
Hallo Crystal, het probleem is hetzelfde. Ik heb een nieuwe tabel voor mezelf gemaakt met slechts 2 rijen. Zodra ik op de knop klik, wordt de lijst uitgebreid tot het einde van de tabel zonder rijen toe te voegen. Het zou moeten worden toegevoegd aan rij nummer 3.
Deze opmerking is gemaakt door de moderator op de site
Hallo Crystal, het probleem is hetzelfde. Ik heb een nieuwe tabel voor mezelf gemaakt met slechts 2 rijen. Zodra ik op de knop klik, wordt de lijst uitgebreid tot het einde van de tabel zonder rijen toe te voegen. Het zou moeten worden toegevoegd aan rij nummer 3.
Deze opmerking is gemaakt door de moderator op de site
Probeer deze Vba-code om een ​​nieuwe regel aan je tabel toe te voegen

Sub Tab_Line_Add()
Dim pswStr As String
pswStr = "123"
On Error Resume Next
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:=pswStr
ActiveSheet.Bereik ("D8").Selecteer
'D8 is tabelkoptekst'
Bereik ("Tabel1[[#Headers],[Totaal]]").Selecteer
Selection.End (xlDown) rechtenmenu.Selecteer
Selection.ListObject.ListRows.Add AlwaysInsert:=False
ActiveSheet.Protect Password:=pswStr

End Sub
.
Deze opmerking is gemaakt door de moderator op de site
Hallo Mac,
Bedankt voor het delen.
Deze opmerking is gemaakt door de moderator op de site
het gebruik van de voorgestelde (Selection.ListObject.ListRows.Add AlwaysInsert:=False) loste een soortgelijk probleem voor mij op met de originele code, waarbij een nieuwe volledige rij (die formules naar beneden uitbreidde) niet zou worden toegevoegd aan de tabel op een veel bredere tabel 51 kolommen. Dus bedankt voor het delen en repareren van Mac.
Deze opmerking is gemaakt door de moderator op de site
Hallo, ik heb de bovenstaande code gebruikt en kreeg de volgende foutmelding:
"Code-uitvoering is onderbroken". Als ik op Debug klik, wordt regel 20 "Selection.ClearContents" gemarkeerd.

Toen ik de code voor het eerst invoerde, werkte deze correct.

Ik heb "Tabel" gewijzigd in de naam van de tabel en de kolom gewijzigd in de naam van de kolom die ik gebruik. Ik heb ook de "Selection.Offset (x,-x).Select" gewijzigd om aan mijn behoeften te voldoen.


Om het even welke suggesties in verband met waarom dit gebeurt?
Deze opmerking is gemaakt door de moderator op de site
Hallo,

de code werkte aanvankelijk, maar nadat ik het werkblad had gedupliceerd, bleef het na 24 uur staan ​​​​toen verdween alle code. En nu kan ik het werkblad niet openen.

het blijft me een onjuist wachtwoord vertellen. En de code is verdwenen. .
Deze opmerking is gemaakt door de moderator op de site
Merhaba Tablo ismini ve satır başlangıc yerlerini değiştirdiğim zaman çalışmıyor yardımcı olurmusunuz
Deze opmerking is gemaakt door de moderator op de site
Hoi,
Zorg ervoor dat u in de code exact dezelfde tabelnaam en kolomkop hebt gewijzigd.
Ik heb de tabelnaam en de kolomkop gewijzigd om de code te testen, en het werkt goed.
Heb je een foutmelding gekregen? Ik wil meer specifiek weten over uw probleem, zoals uw Excel-versie. Hoe gedetailleerder u de fout beschrijft, hoe sneller we deze kunnen begrijpen en oplossen.
Deze opmerking is gemaakt door de moderator op de site
Hoe maak ik een knop om lijnen te wissen?
Deze opmerking is gemaakt door de moderator op de site
Hello!
Tengo is een tabla die een van de kolommen van een protegida bevat.
La tabla tiene 17 columnas de las cuales 7 deben quedar bloqueadas porque poseen formulas.
Mi tabla arranca en celda A4

Dit is een voorbeeld van een gebruiksvriendelijke versie van het programma, dat kan worden gevolgd door "CLAVE", "MITABLA" en "AVISO 1" met verschillende bijzonderheden:
Donde "AVISO 1" komt overeen met een una de las columnas que está protegida.

Dim pswStr As String
'Bijwerken door' ExtendOffice 20181106
pswStr = "KLAP"
On Error Resume Next
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:=pswStr
ActiveSheet.Bereik ("A4").Selecteer
Bereik ("MITABLA[[#Headers],[AVISO 1]]").Selecteer
Selection.End (xlDown) rechtenmenu.Selecteer
Selectie.Offset(1, -16).Selecteren
ActiveCell.FormulaR1C1 = "nieuw"
ActiveSheet.Protect Password:=pswStr, DrawingObjects:=False, _
Inhoud:=True, Scenario's:=False, _
AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, _
AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
AllowDeletingColumns:=True, AllowDeletingRows:=True, _
AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
Selectie.ClearInhoud
Application.ScreenUpdating = True

Het is een goed voorbeeld van een taal die kan worden geschreven en die is toegevoegd aan de huidige lijst met tabla's, een lijst van "nieuwe" en een nieuwe cel met de inhoud van de column "AVISO 1".

Surgen versterkt 2 dudas:
1. Wat is er te zien aan de hand van een bepaalde kolom protegida?
2. Is er een está haciendo esto el código definido?

Agradezco de antemano que me puedan ayudar! Estaré atenta.
Deze opmerking is gemaakt door de moderator op de site
Hallo Daina,
1. Als de 7 formulekolommen die u wilt beveiligen opeenvolgend in de tabel staan.
De koppen van de kolommen zijn bijvoorbeeld gg, hh, ii, jj, kk, ll, mm zoals weergegeven in de onderstaande schermafbeelding. U kunt de volgende VBA-code toepassen om het voor elkaar te krijgen.
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/table.png
In deze lijn Set xRg = Range("Tabel3[[#Headers],[gg]:[mm]]").Offset(1, 0) in de volgende code hoeft u alleen de koppen van de eerste kolom en de laatste kolom in te voeren.
Sub Button1_Click()
 'Update by ExtendOffice 20220826
    Dim xRg, tableRg As Range
    Dim xRowCount As Integer
    Dim pswStr As String
    pswStr = "123"
    On Error Resume Next
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:=pswStr

    'Change the table name and the column headers
    Set tableRg = ActiveSheet.ListObjects("Table3").Range
    xRowCount = tableRg.Rows.Count
    
     Set xRg = Range("Table3[[#Headers],[gg]:[mm]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, xRg.Columns.Count)

    xRg.Resize(xRowCount - 1, xRg.Columns.Count).AutoFill Destination:=yRg, Type:=xlFillDefault
    

    ActiveSheet.Protect Password:=pswStr, DrawingObjects:=False, _
                    Contents:=True, Scenarios:=False, _
                    AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                    AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                    AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
                    AllowDeletingColumns:=True, AllowDeletingRows:=True, _
                    AllowSorting:=True, AllowFiltering:=True, _
                    AllowUsingPivotTables:=True
    Application.ScreenUpdating = True
End Sub

2. Als de 7 formulekolommen die u wilt beschermen, onderbroken zijn in de tabel. Pas de volgende code toe. In de code moet u de koppen van de kolommen één voor één handmatig invoeren.
Sub Button1_Click()
 'Update by ExtendOffice 20220826
    Dim xRg, tableRg As Range
    Dim xRowCount As Integer
    Dim pswStr As String
    pswStr = "123"
    On Error Resume Next
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:=pswStr

    'Change the table name and the column headers
    Set tableRg = ActiveSheet.ListObjects("Table3").Range
    xRowCount = tableRg.Rows.Count
    
    Set xRg = Range("Table3[[#Headers],[gg]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[hh]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[ii]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[jj]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[kk]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
     Set xRg = Range("Table3[[#Headers],[ll]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[mm]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault

    ActiveSheet.Protect Password:=pswStr, DrawingObjects:=False, _
                    Contents:=True, Scenarios:=False, _
                    AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                    AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                    AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
                    AllowDeletingColumns:=True, AllowDeletingRows:=True, _
                    AllowSorting:=True, AllowFiltering:=True, _
                    AllowUsingPivotTables:=True
    Application.ScreenUpdating = True
End Sub
Er zijn nog geen reacties geplaatst
Laat uw commentaar
Posten als gast
×
Beoordeel dit bericht:
0   Personages
Voorgestelde locaties