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

String spatie verwijderen uit een kolom

Status
Niet open voor verdere reacties.
J

jamstar

Gebruiker
Lid geworden
16 dec 2015
Berichten
39
Goedeavond,


Ik zit met het volgende probleem. In het blad (uitvoer) wil ik in de kolom C de spaties aan de voor- en achterzijde laten vervallen. Hoe kan ik dit het beste oplossen met VBA.

Alvast bedankt,
 
Kan het niet zonder VBA?
excel heeft de functie SPATIES.WISSEN voor dit doeleinde.
 
Timshel zei:
Kan het niet zonder VBA?
excel heeft de functie SPATIES.WISSEN voor dit doeleinde.
Klik om te vergroten...

Nee, is niet mogelijk omdat ik meerdere tabbladen heb. In een andere tabblad (invoer) staan de kolommen die afgedrukt dienen te worden. Deze worden gekoppeld met meerdere formules en zijn in het blad uitvoer te zien. Alleen bij het afdrukken krijg ik meerdere cellen verschillende spaties, terwijl ik in blad invoer de teksten juist verwerkt.zonder spaties aan de voor- en achterzijde
 
Laatst bewerkt:
Dit probleem behoeft verduidelijking met een voorbeeldbestand.
 
Misschien, als de tekst niet van formules afkomstig is.
Code: 
sub hsv()
dim cl as range
for each cl in sheets("uitvoer").columns(3).specialcells(2)
 cl = trim(cl)
 next cl
end Sub
 
Timshel zei:
Dit probleem behoeft verduidelijking met een voorbeeldbestand.
Klik om te vergroten...

Het Excel bestandje is te groot 6,7mb. Ik kan maar max 100kb toevoegen

HSV zei:
Misschien, als de tekst niet van formules afkomstig is.
Code: 
sub hsv()
dim cl as range
for each cl in sheets("uitvoer").columns(3).specialcells(2)
 cl = trim(cl)
 next cl
end Sub
Klik om te vergroten...

Bedankt voor het meedenken, maar helaas doet de formule het niet

Hoe kan je een excel bestand van 6,7mb uploaden?
 
Laatst bewerkt door een moderator:
Graag stoppen met het onnodig quoten, er is een reageerknop.

Zulke grote bestanden kun je hier niet uploaden.

Waar gaat het fout in de code.
Met "Bedankt voor het meedenken, maar helaas doet de formule het niet" kan ik natuurlijk niets.
 
Misschien wat overdreven hierbij mij module 1
 
Laatst bewerkt:
Selecteer de code eens, en druk op # boven in het reageervenster.
 
De quote knop kan je wel vinden, maar de # knop niet?

Laat maar; Misschien dat iemand anders het overnemen wil.
 
Sorry hoor

Code: 
  Public Which As String
Public Choice As Boolean
Public VensterOffset As Integer







Sub Menu()
    Which = True
    Choice = False
    With UserForm1
        For i = 1 To 1000
            .Begin.AddItem (i)
            .Eind.AddItem (i)
        Next
        .KopTekst.Text = Worksheets("project").Cells(6, 2)
        .Projectnaam.Text = Worksheets("project").Cells(1, 2)
        .Projectnummer.Text = Worksheets("project").Cells(2, 2)
        .VoetTekst.Text = Worksheets("project").Cells(10, 2)
        .TopMarge.Text = Worksheets("Project").Cells(23, 2)
        .OnderMarge.Text = Worksheets("Project").Cells(24, 2)
        .LinkerMarge.Text = Worksheets("Project").Cells(25, 2)
        .RechterMarge.Text = Worksheets("Project").Cells(26, 2)
        .LetterGrootte.Text = Worksheets("Project").Cells(27, 2)
        If Worksheets("Project").Cells(30, 2) = 1 Then .EnvLinks = True
        If Worksheets("Project").Cells(30, 2) = 5 Then .EnvRechts = True
        Select Case CInt(Worksheets("project").Cells(29, 2))
        Case 1
            .ConceptFactuur = True
        Case 2
            .DefinitieveFactuur = True
        Case 3
            .MeterkastBrief = True
        Case 4
        .Prijzenboek = True
        Case 5
        .INSTALLAIEPERBOUWNUMMER = True
         Case 6
        .analyse = True
         Case Else
        End Select
        .Show
    End With
    'DialogSheets("dialog1").OptionButtons("Option Button 9").Value = xlOn
    'DialogSheets("dialog1").Show
    Dim vanaf As Integer
    Dim tot As Integer
    If Choice = True Then
        vanaf = CDbl(Worksheets("namen").Cells(60000, 1))
        tot = CDbl(Worksheets("namen").Cells(60001, 1))
        Dim n As Integer
        For n = vanaf To tot
            gaan2 (n)
        Next
    End If
End Sub

Sub gaan2(ByVal bouwnummer As Integer)
    Dim naamr, pR, pC, NR, invoerR, invoerC As Integer
    Dim offsetr As Integer
    Dim offsetC As Integer
    Dim TotaalMemi As Double
    offsetr = 19
    offsetC = 1
    Select Case c
    Case c = 0
    pR = r
    Case Else
        NR = setR(bouwnummer)
        pC = setC(bouwnummer)
        naamr = setR(bouwnummer)
        If naamr <> 0 Then
            Call putName(naamr)
            With Worksheets("invoer")
                invoerR = 3
                invoerC = setC(bouwnummer)
                If invoerC <> 0 Then
                    Sheets("Uitvoer").Range("Uitvoer").ClearContents
                    Sheets("Uitvoer").Range("Uitvoer").Font.Size = Worksheets("Project").Cells(27, 2)
                    Sheets("Uitvoer").Range("Uitvoer").Font.Bold = False
                    putName naamr
                    PutHeader 17, 1
                    TotaalMemi = 0
                    While .Cells(invoerR, 3).Value <> ""
                        If CDbl(.Cells(invoerR, invoerC)) >= 1 Then
                            Worksheets("Uitvoer").Cells(offsetr, offsetC + 3).Value = .Cells(invoerR, 2).Value  'Type/Soort
                            Worksheets("Uitvoer").Cells(offsetr, offsetC + 3).Value = .Cells(invoerR, 3).Value  '?
                            If UCase(.Cells(invoerR, 8).Value) = "OFFERTE" Then

                            End If
                            Worksheets("Uitvoer").Cells(offsetr, offsetC + 6).Value = .Cells(invoerR, invoerC).Value 'Aantal
                            Select Case UCase(Which)
                            Case "CONCEPTFACTUUR"
                                If UCase(.Cells(invoerR, 8).Value) = "OFFERTE" Then
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(invoerR, 2).Value  'Code
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 6).Value = prijs(bouwnummer, .Cells(invoerR, 2).Value) 'Prijs
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value = prijs(bouwnummer, .Cells(invoerR, 2).Value) * CDbl(.Cells(invoerR, invoerC).Value) 'Totaal
                                    TotaalMemi = TotaalMemi + Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value
                                Else
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 2).Value = .Cells(invoerR, 4).Value  'omschrijving
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(invoerR, 2).Value  'code
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 5).Value = .Cells(invoerR, 8).Value 'Prijs
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value = CDbl(.Cells(invoerR, 8).Value) * CDbl(.Cells(invoerR, invoerC).Value) 'Totaal
                                    TotaalMemi = TotaalMemi + Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value
                                End If
                             Case "DEFINITIEVEFACTUUR"
                                If UCase(.Cells(invoerR, 8).Value) = "OFFERTE" Then
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC).Value = .Cells(invoerR, 1).Value      '0 teken
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(invoerR, 2).Value  'Code
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 6).Value = prijs(bouwnummer, .Cells(invoerR, 2).Value) 'Prijs
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value = prijs(bouwnummer, .Cells(invoerR, 2).Value) * CDbl(.Cells(invoerR, invoerC).Value) 'Totaal
                                    TotaalMemi = TotaalMemi + Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value
                                Else
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC).Value = .Cells(invoerR, 1).Value      '0 teken
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 2).Value = .Cells(invoerR, 4).Value  'omschrijving
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(invoerR, 2).Value  'code
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value = CDbl(.Cells(invoerR, 8).Value) * CDbl(.Cells(invoerR, invoerC).Value) 'Totaal
                                End If
                            Case "METERKASTBRIEF"
                                If UCase(.Cells(invoerR, 8).Value) = "OFFERTE" Then
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(invoerR, 2).Value  'Code
                                    TotaalMemi = TotaalMemi + Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value
                                Else
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(invoerR, 2).Value  'code
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 2).Value = .Cells(invoerR, 5).Value  'omschrijving
                                    TotaalMemi = TotaalMemi + Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value
                                End If
                            
                            Case "PRIJZENBOEK"
                                If UCase(.Cells(invoerR, 8).Value) = "OFFERTE" Then
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(invoerR, 2).Value  'Code
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 6).Value = prijs(bouwnummer, .Cells(invoerR, 2).Value) 'Prijs
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value = prijs(bouwnummer, .Cells(invoerR, 2).Value) * CDbl(.Cells(invoerR, invoerC).Value) 'Totaal
                                    TotaalMemi = TotaalMemi + Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value
                                Else
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 2).Value = .Cells(invoerR, 4).Value  'omschrijving
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(invoerR, 2).Value  'code
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value = CDbl(.Cells(invoerR, 9).Value) * CDbl(.Cells(invoerR, invoerC).Value) 'Totaal
                                End If

                            Case "INSTALLATIEPERBOUWNUMMER"
                                If UCase(.Cells(invoerR, 8).Value) = "OFFERTE" Then
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(invoerR, 2).Value  'Code
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 6).Value = prijs(bouwnummer, .Cells(invoerR, 2).Value) 'Prijs
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value = prijs(bouwnummer, .Cells(invoerR, 2).Value) * CDbl(.Cells(invoerR, invoerC).Value) 'Totaal
                                    TotaalMemi = TotaalMemi + Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value
                                Else
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 2).Value = .Cells(invoerR, 4).Value  'omschrijving
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(invoerR, 2).Value  'code
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 5).Value = .Cells(invoerR, 9).Value 'Prijs
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value = CDbl(.Cells(invoerR, 9).Value) * CDbl(.Cells(invoerR, invoerC).Value) 'Totaal
                                    TotaalMemi = TotaalMemi + Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value
                                End If
                            
                             Case "ANALYSE"
                                If UCase(.Cells(invoerR, 8).Value) = "OFFERTE" Then
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(invoerR, 2).Value  'Code
                                    TotaalMemi = TotaalMemi + Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value
                                Else
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 2).Value = .Cells(invoerR, 4).Value  'omschrijving
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(invoerR, 2).Value  'code
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 8).Value = .Cells(invoerR, 13).Value  'bouwnr samenvoegen
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 6).Value = .Cells(invoerR, 14).Value  'aantallen
                                    TotaalMemi = TotaalMemi + Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value
                                End If
                            End Select
                            offsetr = offsetr + 1
                        End If
                        invoerR = invoerR + 1
                    Wend
                    PutFooter offsetr, TotaalMemi, CInt(naamr)
                    
                End If
                
            End With
        End If
    End Select
   Sheets("uitvoer").Select
End Sub
Sub KopVoet(kop As String, voet As String)
    With Worksheets("uitvoer").PageSetup
        .LeftHeader = ""
        'Worksheets("project").Cells(12, 2).Value
        '"" & Chr(10) & "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & "Nieuw Vennep, projekt Getsewoud, 30 koopwoningen :" & Chr(10) & "&""Arial,Vet\&20Opdrachtbevestiging"
        .CenterHeader = ""
        .RightHeader = kop
        .LeftFooter = ""
        'Worksheets("project").Cells(11, 2).Value & Chr(10) & Worksheets("project").Cells(12, 2).Value
        '"S.v.p. per omgaande 1 exemplaar voor accoord getekend retourneren." & Chr(10) & "" & Chr(10) & "Bedragen inclusief 17,5 % Btw"
        .CenterFooter = voet
        '.RightFooter = "&8Pagina &P van &N"
        .LeftMargin = Application.CentimetersToPoints(Worksheets("Project").Cells(25, 2))
        .RightMargin = Application.CentimetersToPoints(Worksheets("Project").Cells(26, 2))
        .TopMargin = Application.CentimetersToPoints(Worksheets("Project").Cells(23, 2))
        .BottomMargin = Application.CentimetersToPoints(Worksheets("Project").Cells(24, 2))
        .HeaderMargin = Application.CentimetersToPoints(0.5)
        '.FooterMargin = Application.CentimetersToPoints(0.5)
        '.PrintHeadings = False
        '.PrintGridlines = False
        '.PrintComments = xlPrintNoComments
        '.PrintQuality = 300
        '.CenterHorizontally = False
        '.CenterVertically = False
        '.Orientation = xlPortrait
        '.Draft = False
        .PaperSize = xlPaperA4
        '.FirstPageNumber = xlAutomatic
        '.Order = xlDownThenOver
        '.BlackAndWhite = False
        '.Zoom = False
        '.FitToPagesWide = 1
        '.FitToPagesTall = 1
    End With
    'ActiveWindow.SelectedSheets.PrintPreview
    Worksheets("uitvoer").Rows.AutoFit
End Sub
Sub PutFooter(offsetr As Integer, Totaal As Double, naamr As Integer)
     Select Case UCase(Which)
    Case "CONCEPTFACTUUR"
        Worksheets("Uitvoer").Cells(12, 2).Value = "OPDRACHTBEVESTIGING"
        Worksheets("Uitvoer").Cells(8, 6).Value = ""
        Worksheets("Uitvoer").Cells(8, 7).Value = ""
        Worksheets("Uitvoer").Cells(offsetr + 3, 2).Value = "Totaal Meer en Minderwerk"
        Worksheets("Uitvoer").Cells(offsetr + 6, 2).Value = "Geldigheidsduur: Deze offerte is geldig tot twee weken na de offertedatum."
        Worksheets("Uitvoer").Cells(offsetr + 5, 2).Value = "Betaling meerwerk: Conform koop/aannemingsovereenkomst."
        Worksheets("Uitvoer").Cells(offsetr + 7, 2).Value = "S.v.p. per omgaande 1 exemplaar voor accoord getekend retourneren, per post of per e-mail."
        Worksheets("Uitvoer").Cells(offsetr + 3, 8).Value = Totaal
        Worksheets("Uitvoer").Cells(offsetr + 3, 8).NumberFormat = "€ #,##0.00_-"
        Worksheets("Uitvoer").Cells(offsetr + 9, 2).Value = "Getekend te :"
        Worksheets("Uitvoer").Cells(offsetr + 10, 2).Value = "Datum :"
        Worksheets("Uitvoer").Cells(offsetr + 11, 2).Value = "Voor accoord koper(s) :"
        Worksheets("Uitvoer").Cells(offsetr + 14, 2).Value = Str(Worksheets("namen").Cells(naamr, 1).Value) + " : " + Worksheets("namen").Cells(naamr, 2).Value + " /of " + Worksheets("namen").Cells(naamr, 3).Value
        Call KopVoet(Worksheets("project").Cells(12, 2).Value & "&""Arial,Vet\&20Offerte", Worksheets("project").Cells(10, 2).Value & Chr(10) & Worksheets("project").Cells(11, 2).Value)
    Case "PRIJZENBOEK"
        Worksheets("Uitvoer").Cells(8, 6).Value = ""
        Worksheets("Uitvoer").Cells(8, 7).Value = ""
        Worksheets("Uitvoer").Cells(12, 4).Value = ""
        Worksheets("Uitvoer").Cells(13, 2).Value = ""
        Worksheets("Uitvoer").Cells(13, 4).Value = ""
        Worksheets("Uitvoer").Cells(14, 4).Value = ""
        Worksheets("Uitvoer").Cells(15, 4).Value = ""
        Worksheets("Uitvoer").Cells(7, 2).Value = ""
        Worksheets("Uitvoer").Cells(10, 6).Value = ""
        Worksheets("Uitvoer").Cells(17, 8).Value = "Totaal ex-btw"
        Worksheets("Uitvoer").Cells(12, 2).Value = "PRIJZENBOEK INSTALLATEUR"
        Worksheets("Uitvoer").Cells(offsetr + 3, 8).NumberFormat = "Totaal"
        Call KopVoet(Worksheets("project").Cells(12, 2).Value & vbCrLf & "&""Arial,Vet\&20Opdrachtbevestiging", Worksheets("project").Cells(10, 2).Value & Chr(10) & Worksheets("project").Cells(11, 2).Value)
    Case "DEFINITIEVEFACTUUR"
        Worksheets("Uitvoer").Cells(10, 8).Value = ""
        Worksheets("Uitvoer").Cells(11, 2).Value = "KOPERSKEUZENLIJST BEHORENDE BIJ DE AANNEMINGSOVEREENKOMST"
        Worksheets("Uitvoer").Cells(12, 2).Formula = Format(Date, "dddd dd mmmm yyyy")
        Worksheets("Uitvoer").Cells(9, 4).Value = ""
        Worksheets("Uitvoer").Cells(12, 4).Value = ""
        Worksheets("Uitvoer").Cells(13, 2).Value = ""
        Worksheets("Uitvoer").Cells(13, 4).Value = ""
        Worksheets("Uitvoer").Cells(14, 4).Value = ""
        Worksheets("Uitvoer").Cells(15, 4).Value = ""
        Worksheets("Uitvoer").Cells(14, 2).Value = "Voor bouwnummer      ................................................................................"
        Worksheets("Uitvoer").Cells(15, 2).Value = "Naam                          ................................................................................"
        Worksheets("Uitvoer").Cells(offsetr + 1, 2).Value = "Sluitingsdatum :"
        Worksheets("Uitvoer").Cells(offsetr + 2, 2).Value = "De uiterlijke datum waarop de door u getekende lijst in bezit moet zijn van de aannemersbedrijf Batenburg"
        Worksheets("Uitvoer").Cells(offsetr + 3, 2).Value = "zal worden bekend gemaakt in een informatiefbrief. "
        Worksheets("Uitvoer").Cells(offsetr + 5, 2).Value = "Handleiding :"
        Worksheets("Uitvoer").Cells(offsetr + 6, 2).Value = "Wij verzoeken u ons uw keuzen kenbaar te maken door de rondjes voor de betreffende onderdelen aan te kruisen."
        Worksheets("Uitvoer").Cells(offsetr + 8, 2).Value = "Bij gemaakte keuzen, verzoeken wij u GEEN opmerkingen, vragen doorhalingen, of iets dergelijks te plaatsen."
        Worksheets("Uitvoer").Cells(offsetr + 9, 2).Value = "Door automatische verwerking worden deze niet gesignaleerd en derhalve niet behandeld."
        Worksheets("Uitvoer").Cells(offsetr + 12, 2).Value = "Getekend te :"
        Worksheets("Uitvoer").Cells(offsetr + 13, 2).Value = "Datum :"
        Worksheets("Uitvoer").Cells(offsetr + 14, 2).Value = "Voor accoord koper(s) :"
        Worksheets("Uitvoer").Cells(8, 6).Value = "Lijstkleur:"
        Worksheets("Uitvoer").Cells(offsetr + 3, 8).NumberFormat = "Totaal"
        Call KopVoet(Worksheets("project").Cells(12, 2).Value & vbCrLf & "&""Arial,Vet\&20Opdrachtbevestiging", Worksheets("project").Cells(10, 2).Value & Chr(10) & Worksheets("project").Cells(11, 2).Value)
    Case "METERKASTBRIEF"
        Worksheets("Uitvoer").Cells(12, 2).Value = "METERKASTLIJST"
        Worksheets("Uitvoer").Cells(8, 6).Value = ""
        Worksheets("Uitvoer").Cells(8, 7).Value = ""
        Call KopVoet(Worksheets("project").Cells(12, 2).Value & vbCrLf & "&""Arial,Vet\&20Meterkastbrief", Worksheets("project").Cells(12, 2).Value & Chr(13) & Worksheets("project").Cells(14, 2).Value)
    Case "INSTALLATIEPERBOUWNUMMER"
        Worksheets("Uitvoer").Cells(12, 2).Value = "INSTALLATIES PER BOUWNUMMER"
        Worksheets("Uitvoer").Cells(8, 6).Value = ""
        Worksheets("Uitvoer").Cells(8, 7).Value = ""
        Worksheets("Uitvoer").Cells(offsetr + 3, 2).Value = "Totaal Meer en Minderwerk voor de installateur"
        Worksheets("Uitvoer").Cells(offsetr + 3, 8).Value = Totaal
        Worksheets("Uitvoer").Cells(offsetr + 3, 8).NumberFormat = "€ #,##0.00_-"
        Worksheets("Uitvoer").Cells(offsetr + 3, 8).Value = Totaal
        Call KopVoet(Worksheets("project").Cells(12, 2).Value & "&""Arial,Vet\&20Offerte", Worksheets("project").Cells(10, 2).Value & Chr(10) & Worksheets("project").Cells(11, 2).Value)
    Case "ANALYSE"
        Worksheets("Uitvoer").Cells(12, 2).Value = "ANALYSE PER OPTIE"
        Worksheets("Uitvoer").Cells(8, 6).Value = ""
        Worksheets("Uitvoer").Cells(8, 7).Value = ""
        Worksheets("Uitvoer").Cells(13, 2).Value = ""
        Worksheets("Uitvoer").Cells(12, 4).Value = ""
        Worksheets("Uitvoer").Cells(13, 4).Value = ""
        Worksheets("Uitvoer").Cells(14, 4).Value = ""
        Worksheets("Uitvoer").Cells(15, 4).Value = ""
        Worksheets("Uitvoer").Cells(17, 6).Value = ""
        Worksheets("Uitvoer").Cells(17, 8).Value = ""
        Worksheets("Uitvoer").Cells(17, 9).Value = "Bouwnummers"
        Case Else
    End Select
    'Using Cell Object
Cells(11, 2).Font.Bold = True
Cells(12, 2).Font.Bold = True
Cells(17, 2).Font.Bold = True
Cells(17, 3).Font.Bold = True
Cells(17, 4).Font.Bold = True
Cells(17, 5).Font.Bold = True
Cells(17, 6).Font.Bold = True
Cells(17, 7).Font.Bold = True
Cells(17, 8).Font.Bold = True
Cells(17, 9).Font.Bold = True

End Sub


Function prijs(ByVal b As Integer, ByVal kode As String) As Double
    With Worksheets("offertes")
        Dim c As Integer
        c = 2
        While .Cells(1, c).Value <> kode
            c = c + 1
        Wend
        If .Cells(b + 1, c).Value = "" Then
            'prijs = "Offerte"
        Else
            prijs = CDbl(.Cells(b + 1, c).Value)
        End If
    End With
End Function
Function datum(ByVal b As Integer, ByVal kode As String) As String
    With Worksheets("offertes")
        Dim c As Integer
        c = 2
        While .Cells(1, c).Value <> kode
            c = c + 1
        Wend
            datum = .Cells(b + 1, c + 1).Value
    End With
End Function
Function sumall(ByVal r As Integer) As Double
Dim sum As Double
    sum = 0
    With Worksheets("uitvoer")
        While r > 1
            If (.Cells(r, 11).Value <> "offerte") And (r <> 17) Then
                sum = sum + CDbl(.Cells(r, 11).Value)
            End If
            r = r - 1
        Wend
    End With
    sumall = sum
End Function
Sub putName(ByVal r As Integer)
    If VensterOffset = 0 Then VensterOffset = 1
    With Worksheets("uitvoer")
            .Cells(12, 4).Value = Worksheets("namen").Cells(r, 2).Value
            .Cells(13, 4).Value = Worksheets("namen").Cells(r, 3).Value
            .Cells(14, 4).Value = Worksheets("namen").Cells(r, 4).Value
            .Cells(15, 4).Value = Worksheets("namen").Cells(r, 5).Value
            .Cells(13, 2).Value = "Bouwnummer " & Worksheets("namen").Cells(r, 1).Value
            .Cells(9, 4).Formula = Format(Date, "dddd dd mmmm yyyy")
      
    End With
End Sub
Function getNR(ByVal r As Integer) As Integer
    getNR = Worksheets("namen").Cells(r, 1)
End Function
Function setC(ByVal NR As Integer) As Integer
    'start NR: (2,12)
    Dim c As Integer
    c = 12
    With Worksheets("invoer")
        While (Val(.Cells(2, c).Value) < NR)
            c = c + 1
        Wend
        If (Val(.Cells(2, c).Value) > NR) Then
            setC = 0
        Else
            setC = c
        End If
    End With
End Function
Function setR(ByVal NR As Integer) As Integer
    'start NR: (1,2)
    Dim naamr As Integer
    naamr = 1
    With Worksheets("namen")
        While (Val(.Cells(naamr, 1).Value) < NR)
            naamr = naamr + 1
        Wend
        If (Val(.Cells(naamr, 1).Value) > NR) Then
            setR = 0
        Else
            setR = naamr
        End If
    End With
End Function
Sub putCodes(ByVal r As Integer, ByVal c As Integer)
    Dim offsetr As Integer
    Dim offsetC As Integer
    offsetr = 22
    offsetC = 1
    With Worksheets("Invoer")
        Worksheets("Uitvoer").Cells(offsetr, offsetC).Value = .Cells(r, 1).Value
        Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(r, 2).Value
        Worksheets("Uitvoer").Cells(offsetr, offsetC + 2).Value = .Cells(r, 3).Value
        Worksheets("Uitvoer").Cells(offsetr, offsetC + 3).Value = .Cells(r, 4).Value
        Worksheets("Uitvoer").Cells(offsetr, offsetC + 4).Value = .Cells(r, 5).Value
    End With
End Sub

Sub PutHeader(StartRow, StartCol)
    With Worksheets("uitvoer")
        
        .Cells(StartRow, StartCol).Value = ""
        .Cells(StartRow, StartCol + 1).Value = "Code"
        .Cells(StartRow, StartCol + 2).Value = "Omschrijving"
        .Cells(StartRow, StartCol + 3).Value = ""
        .Cells(StartRow, StartCol + 3).Value = "Type"
        .Cells(StartRow, StartCol + 5).Value = ""
        .Cells(StartRow, StartCol + 5).Value = "Prijs"
        .Cells(StartRow, StartCol + 6).Value = "#"
        .Cells(StartRow, StartCol + 7).Value = "Totaal"
    End With
End Sub

Sub gaan(ByVal bouwnummer As Integer)
    Dim naamr, pR, pC, NR, invoerR, invoerC As Integer
    Dim offsetr As Integer
    Dim offsetC As Integer
    offsetr = 19
    offsetC = 3
    Select Case c
    Case c = 0
    pR = r
    Case Else
        NR = setR(bouwnummer)
        pC = setC(bouwnummer)
        naamr = setR(bouwnummer)
        If naamr <> 0 Then
            Call putName(naamr)
            With Worksheets("invoer")
                invoerR = 3
                invoerC = setC(bouwnummer)
                If invoerC <> 0 Then
                    Sheets("Uitvoer").Range("B19:z372").ClearContents
                    Sheets("Uitvoer").Range("B19:z372").Font.Size = 10
                    Sheets("Uitvoer").Range("B19:z372").Font.Bold = False
                  
                    While .Cells(invoerR, 2).Value <> ""
                        If CDbl(.Cells(invoerR, invoerC)) >= 1 Then
                            Worksheets("Uitvoer").Cells(offsetr, offsetC).Value = .Cells(invoerR, 2).Value
                            Worksheets("Uitvoer").Cells(offsetr, offsetC + 1).Value = .Cells(invoerR, 3).Value
                            Worksheets("Uitvoer").Cells(offsetr, offsetC + 2).Value = .Cells(invoerR, 4).Value
                            Worksheets("Uitvoer").Cells(offsetr, offsetC + 3).Value = .Cells(invoerR, 5).Value
                            If UCase(.Cells(invoerR, 8).Value) = "OFFERTE" Then
                                Worksheets("Uitvoer").Cells(offsetr, offsetC + 5).Value = datum(bouwnummer, .Cells(invoerR, 2).Value)
                            End If
                            If Which = True Then
                                If UCase(.Cells(invoerR, 8).Value) = "OFFERTE" Then
                                  '  Worksheets("Uitvoer").Cells(offsetR, offsetC + 5).Value = datum(bouwnummer, .Cells(invoerR, 2).Value)
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 6).Value = prijs(bouwnummer, .Cells(invoerR, 2).Value)
                                Else
                                   ' Worksheets("Uitvoer").Cells(offsetR, offsetC + 5).Value = datum(bouwnummer, .Cells(invoerR, 2).Value)
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 6).Value = .Cells(invoerR, 8).Value
                                End If
                            End If
                            Worksheets("Uitvoer").Cells(offsetr, offsetC + 7).Value = .Cells(invoerR, invoerC).Value
                         '   Worksheets("Uitvoer").Cells(offsetR, offsetC + 7).Value = CDbl(.Cells(invoerR, 8).Value) * CDbl(.Cells(invoerR, invoerC).Value)
                         '   offsetR = offsetR + 1
                            If Which = True Then
                                If UCase(.Cells(invoerR, 8).Value) = "OFFERTE" Then
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 8).Value = prijs(bouwnummer, .Cells(invoerR, 2).Value) * CDbl(.Cells(invoerR, invoerC).Value)
                                Else
                                    Worksheets("Uitvoer").Cells(offsetr, offsetC + 8).Value = CDbl(.Cells(invoerR, 8).Value) * CDbl(.Cells(invoerR, invoerC).Value)
                                End If
                            End If
                            offsetr = offsetr + 1
                        End If
                        invoerR = invoerR + 1
                    Wend
                    Worksheets("Uitvoer").Cells(offsetr + 3, offsetC + 3).Value = "Totaal Meer en Minderwerk"
                    Worksheets("Uitvoer").Cells(offsetr + 3, offsetC + 8).Value = sumall(offsetr)
                    'Worksheets("Uitvoer").Cells(offsetR + 5, offsetC).Value = "Keuzelijst 1:"
                    'Worksheets("Uitvoer").Cells(offsetR + 6, offsetC).Value = "Keuzelijst 2:"
                    Worksheets("Uitvoer").Cells(offsetr + 5, offsetC + 3).Value = "Keuzelijst 1:  " + Worksheets("namen").Cells(naamr, 8).Value
                    Worksheets("Uitvoer").Cells(offsetr + 6, offsetC + 3).Value = "Keuzelijst 2:  " + Worksheets("namen").Cells(naamr, 9).Value
                    Worksheets("Uitvoer").Cells(offsetr + 9, offsetC + 3).Value = "Getekend te :"
                    Worksheets("Uitvoer").Cells(offsetr + 10, offsetC + 3).Value = "Datum :"
                    Worksheets("Uitvoer").Cells(offsetr + 12, offsetC + 3).Value = "Voor accoord koper(s) :"
                    Worksheets("Uitvoer").Cells(offsetr + 16, offsetC + 3).Value = Str(Worksheets("namen").Cells(naamr, 1).Value) + " : " + Worksheets("namen").Cells(naamr, 2).Value + " /of " + Worksheets("namen").Cells(naamr, 3).Value
                    'Worksheets("Uitvoer").Cells(offsetR + 6, offsetC).Value = Worksheets("namen").Cells(naamr, 3).Value
                    
                    If Worksheets("uitvoer").Cells(19, offsetC) <> "" Then
                        If Which = True Then
                            Call KopVoet(Worksheets("project").Cells(6, 2).Value & Chr(10) & "&""Arial,Vet\&20Opdrachtbevestiging", Worksheets("project").Cells(10, 2).Value & Chr(10) & Worksheets("project").Cells(11, 2).Value)
                        Else
                            Call KopVoet(Worksheets("project").Cells(6, 2).Value & Chr(10) & "&""Arial,Vet\&20Meterkastbrief", "")
                        End If
                        Worksheets("uitvoer").PrintOut 'Copies:=1
                    End If
                End If
            End With
        End If
    End Select
    Sheets("invoer").Select
End Sub

Ik heb weinig ervaring met VBA, ik kan codes aanpassen, maar zelf bedenken is een probleem. Ik constateer een probleem in de cellen, en ik hoop hier een passend oplossing te krijgen.
 
Laatst bewerkt door een moderator:
Maak eens een voorbeeld-bestand zonder codes.
Het gaat om kolom C, maar hoe komen die gegevens erin met de spaties?
 
Even een kleine "NOTE" of zijstap in dit draadje...

Ik dacht eerst dat "het niet goed ging" door de werking van de TRIM-functie in VBA. Deze wijkt namelijk af van de Worksheet functie TRIM (spaties.wissen). Hiervoor even een kleine testprocedure gemaakt...
Code: 
Sub ff()

    TestWoord = "  spaties  verwijderen uit een zin  "  ' 2 spaties voor en achter de regel + tussen het eerste en tweede woord
    
    MsgBox "VBA functie TRIM: " & Len(Trim(TestWoord)) & " - " & Len(TestWoord)
    MsgBox "Worksheet functie TRIM: " & Len(WorksheetFunction.Trim(TestWoord)) & " - " & Len(TestWoord)
    
End Sub
Maar dankzij dit testje weet ik nu ook weer dat het verschil zit in de spaties tussen de woorden in. De Worksheet functie haalt ook daar de dubbele weg terwijl de VBA functie alleen de spaties aan de voor en achterzijde van een string verwijdert.
 
Bekijk bijlage Voorbeeld.xlsx

Ik heb 2 fragmenten uit twee tabbladen gehaald (zie bijlage). In tabblad (invoer) voer ik koptekst (kolom F) en omschrijving (kolom G) deze teksten wordt gebundeld in kolom D van blad invoer. Doormiddel van een Uniform 1 menu laden waarin ik het bouwnummer en opdrachtbevestiging of meterkast selecteer, worden de gegevens verzameld en (bouwnummer/opdrachtbevestiging/code/omschrijving en prijs/vervolgens gebundeld in blad (uitvoer).

Nu is mij probleem dat ik in Kolom D (invoer) geen spaties toegevoegd heb, bij het bundelen van de gegevens, in uitvoer op in verschillende cellen een spatie of geen spatie toegevoegd is.
 
Zijn het wel spaties ?

Code: 
sub M_snb()
  c00= [C12]

  for j=1 to len(c00)
    msgbox asc(mid(c00,j,1))
  next
End Sub
 
Zo te zien zijn het spaties, daar de gegeven code werkt en de spaties verwijderd.
Ik zie het probleem niet.
 
Ik krijg het gevoel dat het probleem afkomstig is van VBA. In de kolommen waar ik de tekst toevoegt zijn zonder spaties. Wanneer de gegevens op een andere blad (uitvoer) wordt gebundeld krijgt ik in meerder cellen een spatie.

Als ik de lettergrootte wijzigt dat valt de letters door de onderzijde van de cel, de cel past zicht niet automatisch aan het lettergrootte.
 
Laatst bewerkt:
Loop de code door via F8 en stop op die rij die de ongewenste spatie genereert,
dan achterhaal je misschien waar het misloopt.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan