• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

us met database

Status
Niet open voor verdere reacties.
S

Symphysodon

Gebruiker
Lid geworden
14 dec 2012
Berichten
468
Beste Forummers,

Deze is weer veel lastiger dan verwacht.

Ik heb een tabel (Listobject) TBL_Administratie. De tabel moet aangepast kunnen worden met bijvoorbeeld een Edit knop op een userform (usOpmaak). Alleen de elementaanduidingen in kolom 2 mogen aangepast worden, niet toevoegen en/of verwijderen!

Het tweede gedeelte is het maken van een nieuwe tabel TBL_Administratie. De base is dan de originele tabel met alleen de eerste regel, want daar staan allemaal formules in (niet in het voorbeeldbestand overigens) die moeten blijven behouden.
De aanduiding van kolom 2, eerste regel moet wel ook aangepast kunnen worden.

In de bijlage een userform voor het toevoegen en verwijderen van records uit de tabel.
Dit gaat redelijk maar omdat ik het nog niet helemaal begrijp werkt het niet goed. Op het moment dat ik een element toevoeg wordt er ook een lege regel toegevoegd en als ik een element verwijder en vervolgens 1 toevoeg komt de toevoeging boven in de tabel ipv onder in de tabel.

Ik hoop dat iemand mij kan helpen.

Het originele programma is van snb :)

mvg
Marco
 

Bijlagen

Het toevoegen is na een lang weekend ploeteren gelukt, zie bijlage.

Met
Code: 
Private Sub UserForm_Initialize()
   c_01.ColumnCount = 2
   c_01.List = Sheets("Admin").ListObjects("TBL_Administratie").DataBodyRange.Value
End Sub
is het ook gelukt om de tweede kolom zichtbaar te maken in de combobox.
 

Bijlagen

Laatst bewerkt:
In de aangepaste code (zie bijlage) voor het verwijderen van een record blijft de tabel even groot, de laatste regel wordt gekopieerd en voorzien van #N/B. Ik heb geprobeerd die regel met een filter te verwijderen maar dat lukt niet. Het is de bedoeling om met het kruisje in de userform de geselecteerde record uit de tabel te verwijderen. Hoe kan ik dit oplossen?
Code: 
Private Sub B_02_Click()    '   Delete
    With c_01
       .RemoveItem .ListIndex
       If .ListCount > 0 Then .ListIndex = 0
       
       If .ListIndex = -1 Then
         For j = 0 To UBound(.List, 2)
            Me("A_01") = ""
            Me("A_01").Locked = True
         Next
        .Value = ""
       End If
       With Sheets("Admin").ListObjects("TBL_Administratie")
           If c_01.ListCount = 0 Then .DataBodyRange.ClearContents
           If c_01.ListCount > 0 Then .DataBodyRange.Value = c_01.List

            .Range.AutoFilter .ListColumns(1).Range, "#N/B"     'Filter werkt wel maar geeft foutmelding
            .TotalsRowRange.Delete
            .Range.AutoFilter
       End With
    End With
End Sub
 

Bijlagen

Het filter in de 'delete' code werkt nu, behalve als ik eerst een record toevoeg en vervolgens een record verwijder. Op Match krijg ik een fout 2042 en dat is volgens mij logisch vanwege #N/B. Hoe kan ik dit zonder work around goed krijgen?

Code: 
Private Sub B_02_Click()    '   Delete
    Dim c As Variant
    Application.DisplayAlerts = False
    With c_01
       .RemoveItem .ListIndex
       If .ListCount > 0 Then .ListIndex = 0
       
       If .ListIndex = -1 Then
         For j = 0 To UBound(.List, 2)
            Me("A_01") = ""
            Me("A_01").Locked = True
         Next
        .Value = ""
       End If
       With Sheets("Admin").ListObjects("TBL_Administratie")

        c = Application.Match("#N/B", .ListColumns(1).DataBodyRange, 1)
           If c_01.ListCount = 0 Then .DataBodyRange.ClearContents
           If c_01.ListCount > 0 Then .DataBodyRange.Value = c_01.List
            On Error Resume Next
            If IsError(c) Then
                .Range.AutoFilter 1#, "#N/B"
                .DataBodyRange.Delete
                .Range.AutoFilter
            End If
       End With
    End With
End Sub
 
In het Engels/USA denken.
Code: 
.Range.AutoFilter 2,[COLOR=#ff0000] "#N/A"[/COLOR]
 
Als ik alleen het kruisje in usOpmaak gebruik dan werkt het filter goed met "#N/B". Het gaat mis als ik eerst een record toevoeg met het plusje en dan een record verwijder.
 
Ik geloof dat het gelukt is:
Code: 
Private Sub B_02_Click()    '   Delete
    Dim c As Double
    Application.DisplayAlerts = False
    With c_01
       .RemoveItem .ListIndex
       If .ListCount > 0 Then .ListIndex = 0
       
       If .ListIndex = -1 Then
         For j = 0 To UBound(.List, 2)
            Me("A_01") = ""
            Me("A_01").Locked = True
         Next
        .Value = ""
       End If
       With Sheets("Admin").ListObjects("TBL_Administratie")
            If c_01.ListCount = 0 Then .DataBodyRange.ClearContents
            If c_01.ListCount > 0 Then .DataBodyRange.Value = c_01.List
            .Range.AutoFilter 2#, "#N/B", 2, ""
            .DataBodyRange.Delete
            .Range.AutoFilter
       End With
    End With
End Sub

Ik heb de match functie eruit gehaald en gefilterd op zowel #N/B als een lege regel ""
 
Mooi, maar hier werkt het alleen met #N/A terwijl er #N/B in de cel staat.
Dus in z'n algemeenheid zou ik daarvoor kiezen.
 
Dat zou ik wel willen maar het werkt niet. Als ik met de code
Code: 
Private Sub B_02_Click()    '   Delete
    Dim c As Double
    Application.DisplayAlerts = False
    With c_01
       .RemoveItem .ListIndex
       If .ListCount > 0 Then .ListIndex = 0
       
       If .ListIndex = -1 Then
         For j = 0 To UBound(.List, 2)
            Me("A_01") = ""
            Me("A_01").Locked = True
         Next
        .Value = ""
       End If
       With Sheets("Admin").ListObjects("TBL_Administratie")
            If c_01.ListCount = 0 Then .DataBodyRange.ClearContents
            If c_01.ListCount > 0 Then .DataBodyRange.Value = c_01.List
            .Range.AutoFilter 2#, "#N/A", 2, ""
            .DataBodyRange.Delete
            .Range.AutoFilter
       End With
    End With
via het kruisje een record weghaal houd ik een lege lijst over en dat is ook meteen het probleem van dat stukje code, als de filtercriteria niet aanwezig zijn moet het filter uitgezet worden.

Ik heb dat geprobeerd met:
Code: 
c = Application.Match("#N/B", .ListColumns(1).DataBodyRange, 0)
maar krijg dan altijd fout2042 ongeacht of het criteria erin staat of niet (ook deze code heb ik getest met #N/A
 
Als er geen match is, is c geen Double.
Code: 
 Dim c As variant

Code: 
If isnumeric(c) then ......
 
Werkt ook niet ik krijg ongeacht de uitkomst altijd fout 2042
Code: 
Private Sub B_02_Click()    '   Delete
    Dim c As Variant
    Application.DisplayAlerts = False
    With c_01
       .RemoveItem .ListIndex
       If .ListCount > 0 Then .ListIndex = 0
       
       If .ListIndex = -1 Then
         For j = 0 To UBound(.List, 2)
            Me("A_01") = ""
            Me("A_01").Locked = True
         Next
        .Value = ""
       End If
       With Sheets("Admin").ListObjects("TBL_Administratie")
           If c_01.ListCount = 0 Then .DataBodyRange.ClearContents
           If c_01.ListCount > 0 Then .DataBodyRange.Value = c_01.List

           c = Application.Match("#N/B", .ListColumns(1).DataBodyRange, 0)
            If IsNumeric(c) Then
                .Range.AutoFilter 1#, "#N/B"
                .DataBodyRange.Delete
                .Range.AutoFilter
            End If
       End With
    End With
End Sub
 
Ik weet niet waarom match niet werkt maar Find doet het wel, ook met #N/A.
Dus Find met #N/A en AutoFilter met #N/B, anders werkt het niet. Tenminste niet bij mij in ieder geval.
Code: 
Private Sub B_02_Click()    '   Delete
    Dim c As Variant
    Application.DisplayAlerts = False
    With c_01
       .RemoveItem .ListIndex
       If .ListCount > 0 Then .ListIndex = 0
       
       If .ListIndex = -1 Then
         For j = 0 To UBound(.List, 2)
            Me("A_01") = ""
            Me("A_01").Locked = True
         Next
        .Value = ""
       End If
       With Sheets("Admin").ListObjects("TBL_Administratie")
            If c_01.ListCount = 0 Then .DataBodyRange.ClearContents
            If c_01.ListCount > 0 Then .DataBodyRange.Value = c_01.List
            Set r = .DataBodyRange
            If r.Find("#N/A", lookat:=xlWhole) Is Nothing Then
                If r.Find("") Is Nothing Then
                    Exit Sub
                Else
                    .Range.AutoFilter 2#, ""
                    .DataBodyRange.Delete
                    .Range.AutoFilter
                End If
            Else
                .Range.AutoFilter 1#, "#N/B"
                .DataBodyRange.Delete
                .Range.AutoFilter
            End If
       End With
    End With
End Sub
Is een beetje knullig gecodeerd maar weet even niet hoe ik het anders moet doen dan met een Ifthenelse
 
#N/A laat zich dus niet vangen met Match?

Je kan een replace overwegen.

Code: 
 .databodyrange.replace "#N/A", "|||"
          if isnumeric(Application.Match("|||", .ListColumns(2).DataBodyRange, 0)) Then
                .Range.AutoFilter 1, "|||"
 
Het is gelukt.

HSV bedankt.

Code: 
Private Sub UserForm_Initialize()
   c_01.ColumnCount = 2
   c_01.List = Sheets("Admin").ListObjects("TBL_Administratie").DataBodyRange.Value
End Sub

Private Sub c_01_Change()
Application.DisplayAlerts = False
   With c_01
        B_02.Visible = .ListIndex > -1
        B_03.Visible = True
        If .ListIndex = -1 Then Exit Sub
        Me("A_01").Text = .Column(1)
        Me("A_01").Locked = False
    End With
End Sub

Private Sub A_01_Change()
    If c_01.ListIndex > -1 Then c_01.Column(1) = Me("A_01").Text
End Sub

Private Sub B_01_Click()     '   Add
    With Sheets("Admin").ListObjects("TBL_Administratie")
        If c_01.ListCount = 0 Then .DataBodyRange.ClearContents
        If c_01.ListCount > 0 Then .DataBodyRange.Resize(c_01.ListCount).Value = c_01.List
    End With
   
   With c_01                    'in sub c_01_Change
        .AddItem
        .List(.ListCount - 1, 1) = ""
        .ListIndex = .ListCount - 1
   End With

   With Sheets("Admin").ListObjects("TBL_Administratie")
        If c_01.ListCount = 0 Then .DataBodyRange.ClearContents
        If c_01.ListCount > 0 Then .DataBodyRange.Resize(c_01.ListCount - 1).Value = c_01.List
        .ListColumns(2).DataBodyRange.Replace "", "|||"
        If IsNumeric(Application.Match("|||", .ListColumns(2).DataBodyRange, 0)) Then
            .Range.AutoFilter 2#, "|||"
            .DataBodyRange.Delete
            .Range.AutoFilter
        End If

        .DataBodyRange(1, 1).Value = 1
        If .DataBodyRange(2, 1).Value <> Empty Then .DataBodyRange(1, 1).AutoFill .ListColumns(1).DataBodyRange, xlLinearTrend
   End With
End Sub
Private Sub B_02_Click()    '   Delete
    Dim c As Variant
    Application.DisplayAlerts = False
    With c_01
       .RemoveItem .ListIndex
       If .ListCount > 0 Then .ListIndex = 0
       
       If .ListIndex = -1 Then
         For j = 0 To UBound(.List, 2)
            Me("A_01") = ""
            Me("A_01").Locked = True
         Next
        .Value = ""
       End If
       With Sheets("Admin").ListObjects("TBL_Administratie")
            If c_01.ListCount = 0 Then .DataBodyRange.ClearContents
            If c_01.ListCount > 0 Then .DataBodyRange.Value = c_01.List
            
            .DataBodyRange.Replace "#N/A", "|||"                                                            'Match #N/A werkt niet!!
            If IsNumeric(Application.Match("|||", .ListColumns(2).DataBodyRange, 0)) Then
                .Range.AutoFilter 1, "|||"
                .DataBodyRange.Delete
                .Range.AutoFilter
                If IsNumeric(Application.Match("|||", .ListColumns(2).DataBodyRange, 0)) Then
                    .Range.AutoFilter 2#, "|||"
                    .DataBodyRange.Delete
                    .Range.AutoFilter
                End If
            Else
                .ListColumns(2).DataBodyRange.Replace "", "|||"                                            'Match lege cel werkt ook niet!!
                If IsNumeric(Application.Match("|||", .ListColumns(2).DataBodyRange, 0)) Then
                    .Range.AutoFilter 2#, "|||"
                    .DataBodyRange.Delete
                    .Range.AutoFilter
                End If
            End If
            
            .DataBodyRange(1, 1).Value = 1
            If .DataBodyRange(2, 1).Value <> Empty Then .DataBodyRange(1, 1).AutoFill .ListColumns(1).DataBodyRange, xlLinearTrend
            c_01.List = Sheets("Admin").ListObjects("TBL_Administratie").DataBodyRange.Value
            
       End With
    End With
End Sub

Private Sub B_03_Click()    'Refresh
    With Sheets("Admin").ListObjects("TBL_Administratie")
         .DataBodyRange(1, 1).Value = 1
         If .DataBodyRange(2, 1).Value <> Empty Then .DataBodyRange(1, 1).AutoFill .ListColumns(1).DataBodyRange, xlLinearTrend
         c_01.List = Sheets("Admin").ListObjects("TBL_Administratie").DataBodyRange.Value
    End With
   
End Sub
Private Sub cmd_ok_Click()
    Hide
End Sub
 
Zoals het nu werkt kan ik door in de combobox een item te selecteren, het item verwijderen door middel van het rode kruis op de userform. Op dat moment wordt het 1e item van de lijst zichtbaar in de combobox en het tesktvak. Als ik vervolgens nogmaals op het rode kruis klik dan krijg ik een foutmelding: ongeldig argument, op: .RemoveItem.Listindex.

Is het mogelijk om na een selectie van een item dat ik op het rode kruis kan blijven klikken tot alle items verwijderd zijn en dan zo dat na de eerst keer het rode kruis geklikt te hebben dat het eerst volgende item getoond wordt en niet het eerste item van de lijst.
 

Bijlagen

Mijn vraag in #15 is waarschijnlijk te lastig of niet mogelijk met vba maar ik kom nog een probleem tegen.

Hoe kan ik het list item wat ik verwijder met het kruisje, naar een variabel wegschrijven? Dat vraag ik omdat de lijst correspondeerd met een datasheet. In de datasheet is de header de getransponeerde lijst.
 
Iemand?

Als ik in het change event het kolomnummer opvraag dan krijg ik drie keer een waarde te zien: 1x als ik een element selecteer, daarna als ik op het kruis verwijderen klik en daarna krijg ik de waarde 1 te zien. Ik wil alleen de waarde van het klikken op het rode kruis en die waarde wordt steeds overschreven door de waarde 1 (is ook logisch). Maw dit is niet de manier, maar hoe kan het wel?
 
een beetje afwezig geweest.
ik weet niet precies wat de bedoeling was, een lijstje voor "Admin" afvinken tov alle elementen in "Kladblad" ?
 

Bijlagen

Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan