• 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.

Code makkelijker te omschrijven dmv bijvoorbeeld een loop?

Status
Niet open voor verdere reacties.

Goldfoxx

Gebruiker
Lid geworden
22 okt 2010
Berichten
22
Ik heb een formulier gemaakt. Bij het laden van dit formulier worden een aantal tekstvelden gevuld (adres e.d.) aan de hand van een eerder ingevuld klantnummer. Als op het opslaan knopje wordt gedrukt wordt er gecontroleerd of de waardes in de tekstvelden nog overeenkomen met de achterliggende database. Indien dat niet het geval is, worden deze nieuwe waardes weggeschreven naar een ander tabblad. De code werkt, maar is lang en repetitief. Hieronder een voorbeeld van de code, hierbij betreft het maar twee tekstvelden.


Code:
'Zoekt de waardes in een achterliggende database en koppelt deze aan een variabele.
Set colRange = Worksheets("Relatiebestand").Range("A:A")

Var1 = WorksheetFunction.Index(Range("R_Debnaam"), WorksheetFunction.Match(CLng(ComboBox1), colRange, 0) - 1)
Var2 = WorksheetFunction.Index(Range("R_Plaats"), WorksheetFunction.Match(CLng(ComboBox1), colRange, 0) - 1)

'Voert de code uit voor elke textbox en vergelijkt deze met de variabele
'Indien deze niet overeenkomt, en dus is gewijzigd, dan word deze weggeschreven naar de onderste rij van een tabblad
'Hierbij worden de kolommen klantnummer, datum, oude waarde, nieuwe waarde gevuld
'In werkelijkheid gaat het hier om een 15 tal textboxes
If TextBox1 <> Var1 Then
    Newrow = Sheets("mutatie").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    Sheets("Mutatie").Range("A" & Newrow) = ComboBox1
    Sheets("Mutatie").Range("B" & Newrow) = Date
    Sheets("Mutatie").Range("D" & Newrow) = Var1
    Sheets("Mutatie").Range("E" & Newrow) = TextBox1
End If

'Herhaalt de code uit voor de 2e textbox met bijbehorende variabele
If TextBox2 <> Var2 Then
    Newrow = Sheets("mutatie").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    Sheets("Mutatie").Range("A" & Newrow) = ComboBox1.Value
    Sheets("Mutatie").Range("B" & Newrow) = Date
    Sheets("Mutatie").Range("D" & Newrow) = Var2
    Sheets("Mutatie").Range("E" & Newrow) = TextBox2.Value
End If

'etc.

Is er een manier om deze code korter te schrijven, waarbij de tussenliggende code voor elke vergelijking wordt uitgevoerd?
 
Test het zo eens.
Het ligt eraan wat er in kolom C staat,....is deze leeg kan het misschien op onderstaande manier.
Code:
For i = 1 to 15 'aantal Textboxes en Var's
If me("TextBox" & i) <> (Var&i) Then Sheets("mutatie").Cells(Rows.Count, 1).End(xlUp).Offset(1).resize(,5) = array(ComboBox1,Date,"",(Var&i),me("TextBox"&i))
next i
 
Dit werkt helaas niet. Hij ziet var & i als waarde i. MsgBox Var & i, met i = 2, geeft dus enkel 2.
 
Zet Var eens tussen dubbel quotes.
"VAR"& i
 
Hier had ik eerder al mee gerommeld, hij geeft dan wel aan "Var1", "Var2", etc, maar herkent de variabele daarin niet. Binnen de huidige code is "var1" niet gelijk aan de inhoud van het tekstveld, hij voert dus altijd de code uit, waarbij var1, var2, wordt ingevuld in kolom D.
 
Laatst bewerkt:
Heb je de Var's er wel bij staan?
Code:
sub hsv()
Var1 = WorksheetFunction.Index(Range("R_Debnaam"), WorksheetFunction.Match(CLng(ComboBox1), colRange, 0) - 1)
Var2 = WorksheetFunction.Index(Range("R_Plaats"), WorksheetFunction.Match(CLng(ComboBox1), colRange, 0) - 1)
  For i = 1 to 2 
   If me("TextBox" & i) <> "Var"&i Then Sheets("mutatie").Cells(Rows.Count, 1).End(xlUp).Offset(1).resize(,5) = array(ComboBox1,Date,"","Var"&i,me("TextBox"&i))
  next i
end sub

anders je bestandje even plaatsen, zodat ik ook wat kan testen ipv uit de losse pols.
 
Meer dan dit heb je niet nodig (tenzij je informatie niet klopt):

Code:
Sub M_snb()
   sn = Sheets("Relatiebestand").Columns(1).SpecialCells(2)
   
   For j = 1 To UBound(sn)
      If sn(j, 1) <> Me("textbox" & j) Then Sheets("mutatie").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = Array(combobox1, Date, sn(j, 1), Me("textbox" & j))
   Next
End Sub
 
@snb, Er zijn maar max 15 textboxen terwijl ubound(sn) veel omvangrijker kan zijn.
 
Je weet meer dan ik...
Vertel me je geheim.
 
Bij deze het een testversie van het bestand. Hier wordt "Var" & i, met i=1 herkent als Var1, maar niet als de betreffende variabele.

De andere code (die is ook toegevoegd, maar gedeactiveerd), geeft voor Ubound de foutmelding dat er een matrix wordt verwacht.
 

Bijlagen

dit leek me veel simpeler zonder al die benoemde gebieden.
En variabelen heb je evenmin nodig.
 

Bijlagen

Laatst bewerkt:
@octa

Gelukkig; is dat raadsel ook weer opgelost ;)
 
Dat gaat niet helemaal goed, in de laatste versie heb je het mutatieformulier er uitgehaald en wordt de data direct verwerkt. Daarnaast kan er niet geschoven worden met kolommen zonder de vba code te moeten wijzigen. Aangezien de data niet direct verwerkt moet worden, maar eerst moet worden verzameld ter controle door een derde persoon, is dit tabblad juíst van belang.

Het gaat echt alleen om het korter en efficiënter opschrijven van bovenstaande code. In het voorbeeld betreft het 2 velden, maar in het echt dus een stuk of 15.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan