Find & Replace in kolom van tabel

Status
Niet open voor verdere reacties.
M

Micheltje13

Gebruiker
Lid geworden
28 jan 2011
Berichten
132
Hi,

De naam zegt het al. Ik wil een Find & Replace van de . naar de , doen via een VBA in kolom 4 en 6 van een tabel.

Ik heb nu onderstaand. Het selecteren van de kolommen werkt perfect.

Sub SelectColumn()

ActiveDocument.Tables(2).Select
Selection.Tables(1).Columns(4).Select

ActiveDocument.Tables(2).Select
Selection.Tables(1).Columns(6).Select

End Sub

Echter wanneer ik onderstaande find & replace toevoeg onder een van de selecties pakt ie de gehele tabel. Terwijl het echt alleen in kolom 4 en 6 moet gebeuren. Iemand ideeën?

With Selection.Find
.Text = "."
.Replacement.Text = ","
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
Vermijd Select, dit werkt vertragend en is meestal overbodig.
Probeer het hier eens mee.
Code: 
Sub dotchie()
Dim i As String, k As String
    i = "."
    k = ","
    Columns(4).Replace what:=i, replacement:=k
    Columns(6).Replace what:=i, replacement:=k
End Sub
 
Ben benieuwd of dat in Word ook zo werkt ;)
Misschien dat TS even een voorbeeld documentje kan plaatsen.
 
Trap ik ook wel eens in ;)
 
Zeker dat kan ik. Zet even rasterlijnen aan voor de goede weergave van de tabel. In kolom 4 en kolom 6 staan op lettertypegrootte 1 in het wit waardes met punten. Dit is de Amerikaanse notatie. Voor een goede berekening moet hier letterlijk van de punt een komma gemaakt worden. Anders klopt de berekening niet.

Bekijk bijlage WordMerge (12).docx
 
gast0660 zei:
Vermijd Select, dit werkt vertragend en is meestal overbodig.
Probeer het hier eens mee.
Code: 
Sub dotchie()
Dim i As String, k As String
    i = "."
    k = ","
    Columns(4).Replace what:=i, replacement:=k
    Columns(6).Replace what:=i, replacement:=k
End Sub
Klik om te vergroten...

Dit werkt inderdaad niet.. Sub of function niet gedefinieerd.
 
In je voorbeeldbestandje kloppen je kolommen niet (kolom 4 is leeg), en bevat de laatste kolom met 'getallen' (de kolom Price) ook nog het woord EUR. Sowieso kent Word geen getalnotatie, tenzij je er velden voor gebruikt, dus alles wat in de tekst staat wordt als tekst behandeld. Dus ook komma's en punten in getallen. In bijgaande macro heb ik eerst de twee tabellen samengevoegd (er is geen noodzaak voor twee losse tabellen lijkt mij) en met bijgaande macro in de derde kolom de punten vervangen door een komma. De msgboxen zit er tussen als controle, maar die kunnnen uiteraard weg.

Code: 
Sub ModColumn()
Dim kolom As Column, cel As Cell

    Set kolom = ActiveDocument.Tables(1).Columns(3)
    For Each cel In kolom.Cells
        If IsNumeric(Left(cel.Range.Text, Len(cel.Range.Text) - 1)) Then
            MsgBox Left(cel.Range.Text, Len(cel.Range.Text) - 1)
            cel.Range.Text = Replace(cel.Range.Text, ".", ",")
            MsgBox Left(cel.Range.Text, Len(cel.Range.Text) - 1)
        End If
    Next cel
End Sub
 
OctaFish zei:
In je voorbeeldbestandje kloppen je kolommen niet (kolom 4 is leeg), en bevat de laatste kolom met 'getallen' (de kolom Price) ook nog het woord EUR. Sowieso kent Word geen getalnotatie, tenzij je er velden voor gebruikt, dus alles wat in de tekst staat wordt als tekst behandeld. Dus ook komma's en punten in getallen. In bijgaande macro heb ik eerst de twee tabellen samengevoegd (er is geen noodzaak voor twee losse tabellen lijkt mij) en met bijgaande macro in de derde kolom de punten vervangen door een komma. De msgboxen zit er tussen als controle, maar die kunnnen uiteraard weg.

Code: 
Sub ModColumn()
Dim kolom As Column, cel As Cell

    Set kolom = ActiveDocument.Tables(1).Columns(3)
    For Each cel In kolom.Cells
        If IsNumeric(Left(cel.Range.Text, Len(cel.Range.Text) - 1)) Then
            MsgBox Left(cel.Range.Text, Len(cel.Range.Text) - 1)
            cel.Range.Text = Replace(cel.Range.Text, ".", ",")
            MsgBox Left(cel.Range.Text, Len(cel.Range.Text) - 1)
        End If
    Next cel
End Sub
Klik om te vergroten...


Er is een absolute noodzaak om de tabellen los van elkaar te hebben. Dat komt omdat ondanks dat je het niet ziet er een formule in kolom 5 en 7 staat waarbij kolom 4 en kolom 6 met 1000 vermenigvuldigd worden. Daarnaast staat er wel degelijk tekst in maar dan in wit en lettertype 1 omdat dit niet zichtbaar moet zijn in het document. Ik ga even aan de slag met je macro!
 
Uitgevoerd, werkt goed. Echter wil ik de messagebox er tussen uit en gewoon ineen keer alles vervangen hebben. Is dit mogelijk?
 
Dit werkt bij mij in het voorbeeldbestand:

Code: 
Sub M_snb()
  For Each it In ActiveDocument.Tables(2).Columns(8).Cells
    it.Range.Text = Replace(Replace(Replace(it.Range.Text, "EUR ", ""), ",", ""), ".", ",")
  Next
End Sub
 
snb zei:
Dit werkt bij mij in het voorbeeldbestand:

Code: 
Sub M_snb()
  For Each it In ActiveDocument.Tables(2).Columns(8).Cells
    it.Range.Text = Replace(Replace(Replace(it.Range.Text, "EUR ", ""), ",", ""), ".", ",")
  Next
End Sub
Klik om te vergroten...

Hier gaan bij mij nog dingen mis omdat de andere kolommen onaangeraakt moeten blijven.

De code van Octafish is perfect alleen wil ik de messageboxes er tussen uit hebben..
 
Svp niet quoten !

In mijn code gebeurt er niets in andere kolommen dan kolom 8.
 
Bedankt!

Met onderstaande Macro is het gelukt. De . worden nu in , veranderd in kolom 4 en 6. En daarnaast wordt ie vervolgens opgeslagen als pdf.

HTML: 
Sub ModColumn()
Dim kolom As Column, cel As Cell
    Set kolom = ActiveDocument.Tables(2).Columns(4)
    For Each cel In kolom.Cells
        If IsNumeric(Left(cel.Range.Text, Len(cel.Range.Text) - 1)) Then
            cel.Range.Text = Replace(cel.Range.Text, ".", ",")
        End If
    Next cel
        Set kolom = ActiveDocument.Tables(2).Columns(6)
    For Each cel In kolom.Cells
        If IsNumeric(Left(cel.Range.Text, Len(cel.Range.Text) - 1)) Then
            cel.Range.Text = Replace(cel.Range.Text, ".", ",")
        End If
    Next cel
            ActivePrinter = "Microsoft Print to PDF"
    Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
        wdPrintDocumentWithMarkup, Copies:=1, Pages:="", PageType:= _
        wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _
        PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
        PrintZoomPaperHeight:=0
End Sub
 
Laatst bewerkt:
Eigenlijk wil ik nu nog iets anders maar ik kan niet bedenken hoe dit moet. Onze notaties van Euro's staan in Amerikaanse notatie in het systeem.

EUR 2,443.83
EUR 260.92
EUR 1,296.60
EUR 142.94
EUR 788.20
EUR 1,063.88
EUR 251.16

Moet dus zijn:

EUR 2.443,83
EUR 260,92
EUR 1.296,60
EUR 142,94
EUR 788,20
EUR 1.063,88
EUR 251,16

Nu heb ik zojuist geleerd hoe ik punten in komma's verander. Echter hier wil ik zowel de punten in komma's veranderen als de komma's in punten. Enig idee of dit te bewerkstelligen is?
 
Dan krijg je zoiets:
Code: 
Sub Kolommen()
Dim kolom As Column, cel As Cell
Dim i As Integer, x As Integer, iW As Double, arr As Variant
    
    arr = Array(3, 8)
    For i = LBound(arr) To UBound(arr)
        x = arr(i)
        Set kolom = ActiveDocument.Tables(2).Columns(x)
        For Each cel In kolom.Cells
            If x = 8 Then
                iW = Replace(Replace(Replace(Left(cel.Range.Text, Len(cel.Range.Text) - 1), "EUR ", ""), ",", ""), ".", ",")
                cel.Range.Text = "EUR " & Format(iW, "#,##0.00")
            Else
                cel.Range.Text = Replace(Replace(Replace(cel.Range.Text, "EUR ", ""), ",", ""), ".", ",")
            End If
        Next cel
    Next i
''    ActivePrinter = "Microsoft Print to PDF"
''    Application.PrintOut Copies:=1, PageType:=wdPrintAllPages, Collate:=True
End Sub
 
We hebben een andere manier gevonden. In ons systeem echter staan hier nu 3 decimalen achter de komma.

Er staat nu bijvoorbeeld: EUR 155.190 dit moet worden EUR 155,19. Dan klopt mijn formule al. Dus eigenlijk hoeft alleen de laatste cijfer van de laatste kolom verwijderd te worden.
 
Laatst bewerkt:
Hou je niet van werkende oplossingen of zo? :D. De macro werkt perfect, maar nu wil je een nieuwe oplossing voor een inmiddels veranderd probleem?
 
Haha jawel, ik ben je al zeer dankbaar maar ik had een verkeerde koppeling gemaakt met ons systeem waardoor het probleem inderdaad veranderd is. Ik had het bedrag per stuk gekoppeld terwijl het bedrag per 1000 gekoppeld moet zijn. Hierdoor komt er een andere output. Enige wat nu moet is dus de laatste cijfer van kolom 8 verwijderd. Dan ben ik klaar:)
 
Micheltje13 zei:
Er staat nu bijvoorbeeld: EUR 155.190 dit moet worden EUR 155,19. Dan klopt mijn formule al. Dus eigenlijk hoeft alleen de laatste cijfer van de laatste kolom verwijderd te worden.
Klik om te vergroten...
Je geeft nu 3 cijfers achter een punt aan, niet 3 cijfers achter een komma. Dus je vermenigvuldigt nu dus met 1000, waardoor je bedragen krijgt die wat groter zijn. Daar zal dan, logischerwijze, nooit een decimaal in kunnen zitten. Als ik een bedrag als 25,35 met 1000 vermenigvuldig, dan komt daar 25350,00 uit. Sowieso zou dus elk getal op 0 moeten eindigen, niet op ,19 zoals in jouw voorbeeld. Tenzij je het niet over bedragen hebt, maar met 5 cijfers achter de komma in je oorspronkelijke veld werkt (wat voor valutabedragen natuurlijk heel gek is, maar met berekeningen wellicht nog wel kan kloppen).
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan