Opgelost Eigenschappen van cellen wijzigen naar Finacieel mbv VBA

[anton44]

Tot voor kort gaf na het downloaden van mutaties bij de Regiobank geen probleem met betrekking tot celformaten.
Hoewel de cellen in kolom E het formaat Financieel zouden hebben wordt komt dat niet tot uitdrukking. Zou als kolom H moeten zijn. Met selecteren en formaat Financieel kiezen wordt het probleem niet opgelost. Wel met ieder cel apart te selecteren en een enter te gevn.

De getoonde code is een deel uit het totaal van de macro reeksen.
De aanpassingen als oplossing voor het bovengenoemd probleem zou hierin verwerkt moet worden.

Sub RB105_Formules_kopiëren()  'Formules en opmaak kopiëren
'   Application.ScreenUpdating = False
    
    Rows("5:5").Copy
    Rows("8:" & [A200].End(xlUp).Row).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
    Range("F5:O5").Copy
    Range("F8:O" & [A200].End(xlUp).Row).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
    Range("S5:X5").Copy
    Range("S8:X" & [A200].End(xlUp).Row).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
    Range("AB5:AC5").Copy
    Range("AB8:AC" & [A200].End(xlUp).Row).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
    Range("O5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("O8:O" & [A200].End(xlUp).Row).Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False

    Range("b3:b" & [A200].End(xlUp).Row).Name = "CellenbereikIMP"
    For Each cell In Range("CellenbereikIMP")
    If cell = "" Then cell.Offset(, 1) = cell.Offset(, 21).Value 'Plaatst igv "" deel van omschriving in kolom "G"
    Next

    Sheets("importRB").Select
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1:A3").Select

  '  Application.ScreenUpdating = True
  '  Call RB106_Verplaatsen
    
End Sub

 

[lam201]

De waarden in kolom E zijn tekst, geen getallen.
Ook te zien aan het groene driehoekje links bovenin de cel.
Daarom worden ze niet opgemaakt als Financieel.
Typ nog eens een getal in E8, dan zal je de opmaak idd als '€ 165,00' zien.

 

[peter59]

Hoe worden deze gegevens gedownload? Als .Csv, Excel bestand?
Dan lijkt het me een mooie om d.m.v. power query het geheel in te laden, daar eenmalig je plasje over te doen en klaar is Anton44. Geen VBA benodigd.

 

[cow18]

2 mogelijkhden ???

Sub test()

     With Range("A1")                        'ergens een willekeurige ongebruikte cel
          .Value = 1
          .Copy
     End With

     With Range("E8:E18")
          .PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, SkipBlanks:=True
          .NumberFormat = "€ #,##0.00"
     End With

End Sub


Sub Test2()
     Range("E8:E18").TextToColumns Destination:=Range("N8"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=False, _
                                   FieldInfo:=Array(1, 1), DecimalSeparator:=",", ThousandsSeparator:=".", TrailingMinusNumbers:=True
End Sub

 

[anton44]

@cow18,
Bedankt voor je voorstellen.
Mijn bevindingen:
ad test(): Het celformaat wordt niet overeenkomstig Financieel
ad test2(): Het celformaat wordt standaard en ik heb geen mogelijkheid de waardes naar een andere kolom te kopieëren.

 

[anton44]

@peter59​

Heb ik ooit geprobeerd maar kan mijn gewenste opmaak cq werkwijze niet verkrijgen.

 

[popipipo]

Of simpel van 'text naar kolommen'

Sub TextToColumns()
    Range("E8:E18").TextToColumns Destination:=Range("E8"), DataType:=xlDelimited
End Sub

 

[anton44]

lam201​

Precies maar nu de oplossing

 

[anton44]

Of simpel van 'text naar kolommen'

Sub TextToColumns()
    Range("E8:E18").TextToColumns Destination:=Range("E8"), DataType:=xlDelimited
End Sub

Bedankt .
Werkt !

 

[anton44]

Werkt ook uitstekend in mijn origineel met bijbehorende aanpassinkjes.

'Sub TextToColumns() 'Formaat Financieel afdwingen voor kolom E (tekst naar waarde = Helpmij.nl)
    Range("E8:E" & [A200].End(xlUp).Row).Select
    Selection.TextToColumns Destination:=Range("E8"), DataType:=xlDelimited
'End Sub

 

[emields]

je kan het eventueel ook zo doen.

 

[anton44]

@emields.
Bedankt voor de aanvulling.