Uuraanpassing (met 2 uur)

[NIh1IlO]

Dag specialisten,

Ik zou in onderstaande macro (in VBA Excel) het uur automatisch willen laten verhogen met 2 uur.

[

I]Sub tabel_aanpassen_quiz()
'
' tabel_aanpassen Macro
'

'
    Columns("A:A").ColumnWidth = 18.43
    Range("A2:A100").Select
    Selection.NumberFormat = "dd/mm/yyyy hh:mm:ss"
    Columns("G:G").Select
    Selection.ClearContents
End Sub[/I]

Welke code moet ik precies invullen om dezelfde selectie (Range("A2:A100").Select) automatisch 2 uur later te laten weergeven?

Met vriendelijke dank op voorhand,

nIh1IlO

 

[pasan]

hoe vul je de cellen in de range ("A2:A100") hoe komen deze cellen aan hun datum en tijd waarde?

 

[NIh1IlO]

Het zijn de gegevens van een invulformulier CF7 vanuit onze site WordPress, die volgens de macro al werden aangepast in de gewenste vorm, maar die eigenlijk 2 uur later zijn dan onze uurzone.

 

[pasan]

probeer deze is

Sub tabel_aanpassen_quiz()
'
' tabel_aanpassen Macro
Dim A As Integer
Dim LastRow As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
With ActiveSheet.Range("A2:A100")
  Columns(1).ColumnWidth = 18.43
  .NumberFormat = "dd/mm/yyyy hh:mm:ss"
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
     For A = 0 To LastRow
     
    If .Cells(A, "A") = "" Then GoTo volgende
   .Cells(A, "A") = DateAdd("h", 2, .Cells(A, "A"))

volgende:
Next A

 Columns(7).ClearContents
End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[NIh1IlO]

Bedankt Pasan voor de snelle reactie.
Deze instructielijn geeft echter een foutmelding: .Cells(A, "A") = DateAdd("h", 2, .Cells(A, "A"))

 

[pasan]

en zo?

Sub tabel_aanpassen_quiz()
'
' tabel_aanpassen Macro

Dim c As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 On Error Resume Next
With ActiveSheet.Range("A2:A100")
  Columns(1).ColumnWidth = 18.43
  .NumberFormat = "dd/mm/yyyy hh:mm:ss"
End With

  For Each c In Range("a2:a" & Range("A100").Row)
  If c = "" Then GoTo volgende
  c = DateAdd("h", 2, c)

volgende:
Next

 Columns(7).ClearContents

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[NIh1IlO]

Van harte en vriendelijk bedankt voor de snelle en adequate oplossing. :thumb:

nIh1IlO

 

[pasan]

graag gedaan, succes

 

[snb]

of sneller/eenvoudiger

Sub tabel_aanpassen_quiz()
  sn=Range("A2:A100")

  for j=1 to ubound(sn)
     sn(j,1)=dateadd("h",2,sn(j,1))
  next

  Range("A2:A100")=sn
  columns(7).clearcontents
end sub

 

[NIh1IlO]

Beste snb,

De code doet niet wat ik wenste: de reeds ingevoerde gegevens worden niet aangepast aan het gewenste format maar de range wordt wel aangevuld tot A100, zelfs voor de lijnen waar er niets werd ingevuld.
Misschien moet er iets aangepast worden.
In elk geval ook bedankt voor het meedenken. Hoe eenvoudiger hoe liever!

 

[snb]

Voor opmaak van een gebied heb je geen VBA nodig.

Sub tabel_aanpassen_quiz()
  sn=Range("A2:A100").specialcells(2)

  for j=1 to ubound(sn)
     sn(j,1)=dateadd("h",2,sn(j,1))
  next

  Range("A2:A100").specialcells(2)=sn
  columns(7).clearcontents
end sub

of als je echt van simpel houdt:

Sub snb()
    [A2:A100] = [if(A2:A100="","",TEXT(TIME(HOUR(A2:A100)+2,MINUTE(A2:A100),0),"hh:mm"))]
End Sub

 

[NIh1IlO]

Voor opmaak van een gebied heb je geen VBA nodig.

Sub tabel_aanpassen_quiz()
  sn=Range("A2:A100").specialcells(2)

  for j=1 to ubound(sn)
     sn(j,1)=dateadd("h",2,sn(j,1))
  next

  Range("A2:A100").specialcells(2)=sn
  columns(7).clearcontents
end sub

of als je echt van simpel houdt:

Sub snb()
    [A2:A100] = [if(A2:A100="","",TEXT(TIME(HOUR(A2:A100)+2,MINUTE(A2:A100),0),"hh:mm"))]
End Sub

Beste snb,

De 1e code doet het, maar ik zou het liever zien in het format dd/mm/yyyy hh:mm:ss.
De 2e code geeft enkel het uur weer; de bedoeling is echter de volledige datum-uur constructie.

Alvast opnieuw bedankt voor het blijven meedenken.
nIh1IlO

 

[snb]

Als je geïnteresseerd bent in VBA en je analyseert beide codes op je gemak, kun je die gemakkelijk zelf aanpassen.
Als dat je teveel werk is hoop ik dat ik er anderen wel mee geholpen heb.