VBA tekst toevoegen aan celwaarde

[MrGalbers]

Hi!

Ik ben niet erg wijs in excel, maar ben onderweg om een magento artikellijst te maken t.b.v. webshop. Nu heb ik daar een aantal kolommen in die zo goed als dezelfde naam hebben als een kolom ervoor. Echter zou er .html achter geplakt moeten worden.

Heb wat gegoogled en kwam ergens op dit forum het volgende scriptje tegen;

Sub fff()

    Dim arr()
    Dim l1 As Long
    Dim l2 As Long
    
    With Range("A1").CurrentRegion

        ReDim arr(1 To .Rows.Count, 1 To .Columns.Count)
        
        arr = .Value
        
        For l1 = LBound(arr, 1) To UBound(arr, 1)
        
            For l2 = LBound(arr, 2) To UBound(arr, 2)
        
                arr(l1, l2) = arr(l1, l2) & ".html"
                
            Next
        
        Next
        
        .Value = arr
    
    End With
    
End Sub

Als ik deze toepas dan komt overal '.html' erachter te staan, maar zou dit graag willen hebben op de cellen O2 tot het oneindige. Cellen zonder waarde hoeven de toevoeging uiteraard niet te krijgen.

Hoe kan ik dit script beperken tot de cellen c.q. kolommen die ik graag zou willen hebben?

Alvast dank!

Groeten, Merijn

 

[MrGalbers]

Hi Edmoor,

ik krijg nu geen resultaten bij het uitvoeren ervan. Kan op geen van de cellen een toevoeging vinden.

Gr M

 

[edmoor]

Plaats je document even, want kennelijk is die kolom O wat anders.

 

[MrGalbers]

Deze dus...

Bekijk bijlage export_all_products EXCEL MET MACRO TEST.xlsm

 

[edmoor]

Ok. Deze dan:

Sub fff()
    Dim arr()
    Dim l1 As Long
    Dim l2 As Long
    
    With Range("A1").CurrentRegion
        ReDim arr(1 To .Rows.Count, 1 To .Columns.Count)
        arr = .Value
        For l1 = LBound(arr, 1) To UBound(arr, 1)
                Debug.Print l1
            For l2 = LBound(arr, 2) To UBound(arr, 2)
                If l2 = 15 And l1 > 1 Then
                    arr(l1, l2) = arr(l1, l2) & ".html"
                Else
                    arr(l1, l2) = arr(l1, l2)
                End If
            Next
        Next
        .Value = arr
    End With
End Sub

Maar het kan veel eenvoudiger als je alleen de waarden in kolom O wilt uitbreiden met .html

 

[MrGalbers]

Score! Erg relaxed! Dank!

Nu kan ik hem zelf met een beetje handigheid aanpassen naar andere variabelen!

 

[MrGalbers]

Zie het nu pas;

hoe kan het dan eenvoudiger? Op zich kan ik altijd nog moeilijk gaan doen

 

[edmoor]

Op deze manier:

Sub AddHTML()
    Dim i As Long
    With ActiveSheet
        For i = 2 To .Cells(.Rows.Count, "O").End(xlUp).Row
            If Right(.Cells(i, 15), 5) <> ".html" Then
                .Cells(i, 15) = .Cells(i, 15) & ".html"
            End If
        Next i
    End With
End Sub

Waarbij de If en End If regels misschien nog wel weg kunnen.

 

[MrGalbers]

Deze werkt inderdaad beter. Geen idee waarom, maar er komen geen dubbele extensies meer achter...

Thanks!!

 

[edmoor]

Daarom zit die If Right(.Cells(i, 15), 5) <> ".html" Then regel er in
Dan wordt het er alleen achter gezet als het er nog niet staat.

 

[VenA]

Iets andere methode

Sub VenA()
With ActiveSheet
    ar = .Range("O2:O" & .UsedRange.Rows.Count)
    For j = 1 To UBound(ar)
        If ar(j, 1) = "" Or Right(ar(j, 1), 5) = ".html" Then c00 = c00 & ar(j, 1) & "|" Else c00 = c00 & ar(j, 1) & ".html|"
    Next j
    .Range("O2").Resize(UBound(ar), 1) = Application.Transpose(Split(c00, "|"))
End With
End Sub

 

[snb]

of gebruik de aangepaste opmaak: @".html"

 

[rebmog]

Nog een andere methode:

Sub rebmog()
    [o2:o10000] = [if(len(o2:o10000)=0,"",if(right(o2:o10000,5)<>".html",o2:o10000&".html",o2:o10000))]
End Sub