formule datum omzetten in vba

[deschrik]

Hallo allemaal,

Ik bepaal van een willekeurige datum de desbetreffende maand en het bijbehorende jaartal. Als in de datum niets staat, wordt bij de maand en het jaartal ook niets weergegeven. Voor de duidelijkheid heb ik een bijlage meegestuurd.

Nu wil ik graag dat de formules die in kolom B, C en D staan voor het bepalen van de juiste maand, jaartal en de samenvoeging, worden omgezet naar een VBA-code.
Wanneer blad 1 wordt geactiveerd moeten dus automatisch deze formules worden gemaakt. Dit wil ik graag omzetten ivm het verkleinen van het excelbestand.

Hopelijk kan iemand mij voorthelpen.

 

[Roncancio]

Zoiets:

Private Sub Worksheet_Activate()
Dim rBereik As Range
    For Each rBereik In Range("A1:A100")
        If rBereik.Value <> "" And IsDate(rBereik) Then
            Range("B" & rBereik.Row).Value = Month(rBereik)
            Range("C" & rBereik.Row).Value = Year(rBereik)
            Range("D" & rBereik.Row).Value = Year(rBereik) & Month(rBereik)
        End If
    Next
End Sub

Met vriendelijke groet,


Roncancio

 

[deschrik]

Wederom hartelijk dank Roncancio voor je goede hulp!:thumb:

Nu wil ik dit graag ook doen voor ALS-formule. Voor de duidelijkheid weer een bijlage. Het is de bedoeling dat de formules die op het tabblad 'km' worden omgezet naar vba-code. Zodat wanneer tabblad 'km' word geactiveerd, automatisch de juiste waardes erin komen te staan. Hopelijk kan iemand mij hiermee ook helpen, het helpt mij enorm met het verkleinen van een excelbestand!

 

[Roncancio]

Wederom hartelijk dank Roncancio voor je goede hulp!:thumb:

Nu wil ik dit graag ook doen voor ALS-formule. Voor de duidelijkheid weer een bijlage. Het is de bedoeling dat de formules die op het tabblad 'km' worden omgezet naar vba-code. Zodat wanneer tabblad 'km' word geactiveerd, automatisch de juiste waardes erin komen te staan. Hopelijk kan iemand mij hiermee ook helpen, het helpt mij enorm met het verkleinen van een excelbestand!

Bij deze.

Private Sub Worksheet_Activate()
Dim rBereik As Range
Dim dTarief As Double
    dTarief = Worksheets("Landen").Range("B1").Value
    For Each rBereik In Range("B2:B100")
        If rBereik.Value <> "" Then
            With Worksheets("Landen").Range("A:A")
                Set land = .Find(rBereik.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not land Is Nothing Then
                    Range("C" & rBereik.Row).Value = Worksheets("Landen").Range("B" & land.Row) * dTarief
                End If
            End With
        End If
    Next
End Sub

In plaats van de ALS-functie kon je overigens beter gebruik maken van een zoekfunctie.

Met vriendelijke groet,


Roncancio

 

[deschrik]

Dankuwel!

En hoe wordt de vba-code dan de waardes horizontaal worden gezet? Want zoals ik nu de bijlage heb, heb ik ook mijn echte excelblad ingedeeld.

 

[Roncancio]

Dankuwel!

En hoe wordt de vba-code dan de waardes horizontaal worden gezet? Want zoals ik nu de bijlage heb, heb ik ook mijn echte excelblad ingedeeld.

Dat zou er dan zo uitzien:

Private Sub Worksheet_Activate()
Dim rBereik As Range
Dim dTarief As Double
    dTarief = Worksheets("Landen").Range("B1").Value
    For Each rBereik In Range("B2:B100")
        If rBereik.Value <> "" Then
            With Worksheets("Landen").Range("1:1")
                Set land = .Find(rBereik.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not land Is Nothing Then
                    Range("C" & rBereik.Row).Value = Worksheets("Landen").Cells(2, land.Column) * dTarief
                End If
            End With
        End If
    Next
End Sub

Met vriendelijke groet,


Roncancio

 

[deschrik]

Roncancio , hartelijk dank voor al je hulp!:thumb:

Ik zet de vraag op status opgelost!