Help!

PC-Problemen?
De vrijwilligers van Oplossing.be zoeken gratis met u mee!

Hulp bij posten

Recente topics

Auteur Topic: niet aansluitende cellen leegmaken via VBA  (gelezen 12212 keer)

0 leden en 1 gast bekijken dit topic.

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.029
  • Geslacht: Vrouw
  • veni vidi vici
Re: niet aansluitende cellen leegmaken via VBA
« Reactie #60 Gepost op: 08 augustus 2021, 17:26:29 »
Heb alles grondig getest (met beperkte data weliswaar) en alles werkt naar wens op één klein schoonheidsfoutje na...
Na het klikken op de opdrachtknop en het leegmaken van het UserForm staat de dropdown list van de eerste combobox open.
Op zich niet persé problematisch, wel lichtjes storend....
Gezien er momenteel nog niet veel data in de lijsten/tabellen staan kunnen er misschien op termijn nog bugjes optreden waarvoor ik dan vermoedelijk opnieuw hier om raad zal komen vragen  ;D.

Dit is uiteindelijk de code geworden achter de opdrachtknop (vermoedelijk kan het korter maar op deze wijze is de code voor de verschillende onderdelen (soorten akten) voor mij duidelijker en overzichtelijker) :

Private Sub CommandButton1_Click()
If TextBox1 = "g" Then
    With Sheets("IDX-geb")
        i = .Range("A" & Rows.Count).End(xlUp).Offset(1).Row
            .Range("A" & i).Resize(, 11) = Array(TextBox2, CDbl(TextBox3), CDbl(TextBox4), CDbl(TextBox5), ComboBox1.Text, ComboBox2.Text, ComboBox3.Text, _
            ComboBox4.Text, ComboBox5.Text, ComboBox6.Text, ComboBox7.Text)
        .Columns("A:K").EntireColumn.AutoFit
    End With
    For i = 1 To 7
        Select Case Mid(Me("ComboBox" & i).Name, 9)
            Case 1
                If Len(Me("ComboBox" & i)) > 0 Then
                    With Sheets("inhoud keuzelijsten").ListObjects("plaats")
                        If Not IsNumeric(Application.Match(Me("ComboBox" & i), .DataBodyRange, 0)) Then
                            .ListRows.Add.Range = Me("ComboBox" & i)
                            .Range.Sort .DataBodyRange(1, 1), 1, , , , , , 1
                        End If
                    End With
                End If
            Case 2, 3, 6
                If Len(Me("ComboBox" & i)) > 0 Then
                    With Sheets("inhoud keuzelijsten").ListObjects("naam")
                        If Not IsNumeric(Application.Match(Me("ComboBox" & i), .DataBodyRange, 0)) Then
                            .ListRows.Add.Range = Me("ComboBox" & i)
                            .Range.Sort .DataBodyRange(1, 1), 1, , , , , , 1
                        End If
                    End With
                End If
            Case 4, 5, 7
                If Len(Me("ComboBox" & i)) > 0 Then
                    With Sheets("inhoud keuzelijsten").ListObjects("voornaam")
                        If Not IsNumeric(Application.Match(Me("ComboBox" & i), .DataBodyRange, 0)) Then
                            .ListRows.Add.Range = Me("ComboBox" & i)
                            .Range.Sort .DataBodyRange(1, 1), 1, , , , , , 1
                        End If
                    End With
                End If
        End Select
    Next
End If

If TextBox1 = "h" Then
    With Sheets("IDX-huw")
        i = .Range("A" & Rows.Count).End(xlUp).Offset(1).Row
            .Range("A" & i).Resize(, 16) = Array(TextBox2, CDbl(TextBox3), CDbl(TextBox4), CDbl(TextBox5), ComboBox1.Text, ComboBox2.Text, ComboBox3.Text, _
            ComboBox4.Text, ComboBox5.Text, ComboBox6.Text, ComboBox7.Text, ComboBox8.Text, ComboBox9.Text, ComboBox10.Text, ComboBox11.Text, ComboBox12.Text)
        ii = i + 1
            If TextBox2 = "m" Then TextBox2 = "v"
            .Range("A" & ii).Resize(, 16) = Array(TextBox2, CDbl(TextBox3), CDbl(TextBox4), CDbl(TextBox5), ComboBox1.Text, ComboBox8.Text, ComboBox8.Text, _
            ComboBox9.Text, ComboBox10.Text, ComboBox11.Text, ComboBox12.Text, ComboBox2.Text, ComboBox4.Text, ComboBox5.Text, ComboBox6.Text, ComboBox7.Text)
        .Columns("A:P").EntireColumn.AutoFit
    End With
    For i = 1 To 12
        Select Case Mid(Me("ComboBox" & i).Name, 9)
            Case 1
                If Len(Me("ComboBox" & i)) > 0 Then
                    With Sheets("inhoud keuzelijsten").ListObjects("plaats")
                        If Not IsNumeric(Application.Match(Me("ComboBox" & i), .DataBodyRange, 0)) Then
                            .ListRows.Add.Range = Me("ComboBox" & i)
                            .Range.Sort .DataBodyRange(1, 1), 1, , , , , , 1
                        End If
                    End With
                End If
            Case 2, 3, 6, 8, 11
                If Len(Me("ComboBox" & i)) > 0 Then
                    With Sheets("inhoud keuzelijsten").ListObjects("naam")
                        If Not IsNumeric(Application.Match(Me("ComboBox" & i), .DataBodyRange, 0)) Then
                            .ListRows.Add.Range = Me("ComboBox" & i)
                            .Range.Sort .DataBodyRange(1, 1), 1, , , , , , 1
                        End If
                    End With
                End If
            Case 4, 5, 7, 9, 10, 12
                If Len(Me("ComboBox" & i)) > 0 Then
                    With Sheets("inhoud keuzelijsten").ListObjects("voornaam")
                        If Not IsNumeric(Application.Match(Me("ComboBox" & i), .DataBodyRange, 0)) Then
                            .ListRows.Add.Range = Me("ComboBox" & i)
                            .Range.Sort .DataBodyRange(1, 1), 1, , , , , , 1
                        End If
                    End With
                End If
        End Select
    Next
End If

If TextBox1 = "o" Then
    With Sheets("IDX-ovl")
        i = .Range("A" & Rows.Count).End(xlUp).Offset(1).Row
            .Range("A" & i).Resize(, 14) = Array(TextBox2, CDbl(TextBox3), CDbl(TextBox4), CDbl(TextBox5), ComboBox1.Text, ComboBox2.Text, ComboBox3.Text, _
            ComboBox4.Text, ComboBox5.Text, ComboBox6.Text, ComboBox7.Text, ComboBox8.Text, ComboBox9.Text, TextBox18)
        .Columns("A:N").EntireColumn.AutoFit
    End With
    For i = 1 To 9
        Select Case Mid(Me("ComboBox" & i).Name, 9)
            Case 1
                If Len(Me("ComboBox" & i)) > 0 Then
                    With Sheets("inhoud keuzelijsten").ListObjects("plaats")
                        If Not IsNumeric(Application.Match(Me("ComboBox" & i), .DataBodyRange, 0)) Then
                            .ListRows.Add.Range = Me("ComboBox" & i)
                            .Range.Sort .DataBodyRange(1, 1), 1, , , , , , 1
                        End If
                    End With
                End If
            Case 2, 3, 6, 8
                If Len(Me("ComboBox" & i)) > 0 Then
                    With Sheets("inhoud keuzelijsten").ListObjects("naam")
                        If Not IsNumeric(Application.Match(Me("ComboBox" & i), .DataBodyRange, 0)) Then
                            .ListRows.Add.Range = Me("ComboBox" & i)
                            .Range.Sort .DataBodyRange(1, 1), 1, , , , , , 1
                        End If
                    End With
                End If
            Case 4, 5, 7, 9
                If Len(Me("ComboBox" & i)) > 0 Then
                    With Sheets("inhoud keuzelijsten").ListObjects("voornaam")
                        If Not IsNumeric(Application.Match(Me("ComboBox" & i), .DataBodyRange, 0)) Then
                            .ListRows.Add.Range = Me("ComboBox" & i)
                            .Range.Sort .DataBodyRange(1, 1), 1, , , , , , 1
                        End If
                    End With
                End If
        End Select
    Next
End If

'leegmaken van alle text- en comboboxen
For Each ctrl In Me.Controls
    If TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "ComboBox" Then
        ctrl.Value = ""
    End If
Next ctrl

TextBox1.SetFocus

End Sub


Hartelijk dank aan Veerj en Albert voor de uitgebreide hulp.  _/-\o_ :thumbsup:


groetjes,
BlackDevil
1) HP ProDesk (Windows 10 Pro Edu / Intel(R) Core(TM) i5-7500 CPU@ 3.40Ghz 3.41Ghz)
2) Laptop ASUS (Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz)
Beide (RAM : 8,00 GB / 64-bits besturingssysteem, x64-processor)
Extern (Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP ENVY 6030e)
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline RedHead

  • Excel-Expert
  • Ambassadeur
  • *****
  • Berichten: 2.277
  • Geslacht: Man
  • Met Excel lukt 't wel.... (toch???)
Re: niet aansluitende cellen leegmaken via VBA
« Reactie #61 Gepost op: 08 augustus 2021, 20:16:51 »
Lekker bezig BlackDevil!  \o/
______________________________

Groet, Leo

Offline AD1957

  • Ervaren lid
  • ***
  • Berichten: 250
  • Oplossing.be
Re: niet aansluitende cellen leegmaken via VBA
« Reactie #62 Gepost op: 09 augustus 2021, 11:53:06 »
Citaat
Na het klikken op de opdrachtknop en het leegmaken van het UserForm staat de dropdown list van de eerste combobox open.
helemaal beneden in de code:
verander dit
textbox1.setfocuseens in
combobox1.setfocus
textbox1.setfocus
Groet,

Albert

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.029
  • Geslacht: Vrouw
  • veni vidi vici
Re: niet aansluitende cellen leegmaken via VBA
« Reactie #63 Gepost op: 15 augustus 2021, 18:50:58 »
Hey Albert,

Mijn oprechte excuses voor de late reactie.
In een druk moment had ik je reactie via mijn smartphone gelezen met de bedoeling er, zodra ik aan mijn laptop zat, op te reageren.
Maar dit duurde langer dan verwacht waardoor het reageren mij volledig was ontgaan...

Toen ik net nog eens op het forum kwam rondneuzen zag ik links in de recente topics dat jij de laatste reactie had gegeven en toen
besefte ik dus dat ik vergeten te reageren was.

Bij deze dus :

Hartelijk dank voor je tip inzake die eerste combobox  _/-\o_ :thumbsup:

groetjes,
BlackDevil
1) HP ProDesk (Windows 10 Pro Edu / Intel(R) Core(TM) i5-7500 CPU@ 3.40Ghz 3.41Ghz)
2) Laptop ASUS (Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz)
Beide (RAM : 8,00 GB / 64-bits besturingssysteem, x64-processor)
Extern (Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP ENVY 6030e)
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline AD1957

  • Ervaren lid
  • ***
  • Berichten: 250
  • Oplossing.be
Re: niet aansluitende cellen leegmaken via VBA
« Reactie #64 Gepost op: 15 augustus 2021, 21:53:41 »
Geen probleem.
Groet,

Albert

 


www.combell.com