Till en arbetsbok kopierar jag in en tabell bestående av några kolumner med data på ca: 200 rader. En av dessa kolumner (B) består av datumangivelser i text, med formatet ”Dag DD/MM”, exempelvis ”Mån 9/8” för enkla datum eller ”Fre 17/12” för dubbla datum. Datumangivelserna är inte angivna på varenda rad i tabellen, utan enbart på de rader som har värden med nytt datum. (I exempeltabellen nedan anses kolumnerna V1 till V4 vara fulla med värden). Eftersom det inte finns någon referens till Årtal i tabellens datumangivelser hämtas senast registrerade årtal in från sista posten i föregående behandlade tabell (från blad ”Behandlad Tabell”) till cell A2.
Förutsättningarna för att extrahera värdena för DD och MM, samt att tillsammans med Årsangivelsen i cell A2 sammanställa dessa värden till formatet ÅÅÅÅ-MM-DD bör nu finnas. Dessutom skall logiken klara av att känna av när datumangivelsen i text byter År.
Blad = Ny Tabell
A B C D E F G H
1 Reg. År
2 2010
3 Nr. Datum V1 V2 V3 V4 Reg. Datum
4 1 Tis 28/12 2010-12-28
5 2 2010-12-28
6 3 2010-12-28
7 4 Ons 29/12 2010-12-29
8 5 2010-12-29
9 6 2010-12-29
10 7 2010-12-29
11 8 2010-12-29
12 9 Lör 1/1 2011-01-01
13 10 Fre 31/12 2010-12-31
14 11 2010-12-31
15 12 2010-12-31
16 13 2010-12-31
17 14 Lör 1/1 2011-01-01
18 15 2011-01-01
19 16 2011-01-01
20 17 2011-01-01
21 18 2011-01-01
22 osv osv
23
Som jag ser det bör lösningen byggas i en Do-Loop som stegar ner ”ActiveCell” en rad i taget så länge det finns värden i kolumnen ”Nr.” och som fyller i datumvärden i kolumnen ”Reg. Datum” beroende av hur vissa villkor är uppfyllda. Det jag i första hand vill ha hjälp med är de partier nedan som är i format "Bold", men jag tar även tacksamt emot förslag på bättre lösningar av hela konceptet.
Dim Reg_År As Integer
Dim Senaste_DD As Integer
Dim Senaste_MM As Integer
Dim Föregående_MM As Integer
Dim Sist_Reg_År As Range
Set Sist_Reg_År = Sheets("Behandlad Tabell").Range("A1")
Sheets("Ny Tabell").Select
Range("A3").Select
If ActiveCell.Offset(1, 0) > 0 Then
Range("H4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A3").Select
Do
ActiveCell.Offset(1, 0).Select
If ActiveCell.Offset(0, 1) <> "" Then
'kod för att extrahera värden för DD och MM från datumangivelsen i text, och att lagra _
dem som Variabelnamn (Senaste_DD och Senaste_MM).
If ActiveCell.Offset(-1, 7) <> "Reg. Datum" Then
'kod för att extrahera värdet för MM från föregående rads Reg. Datum, och att lagra _
det som Variabelnamn (Föregående_MM).
If Senaste_MM = 1 And Föregående_MM = 12 Then
ActiveCell.Offset(0, 7) = Reg_År + 1 & "-" & Senaste_MM & "-" & Senaste_DD
Else
If Senaste_MM = 12 And Föregående_MM = 1 Then
ActiveCell.Offset(0, 7) = Reg_År - 1 & "-" & Senaste_MM & "-" & Senaste_DD
Else
ActiveCell.Offset(0, 7) = Reg_År & "-" & Senaste_MM & "-" & Senaste_DD
End If
End If
End If
ActiveCell.Offset(0, 7) = ActiveCell.Offset(-1, 7)
End If
Loop Until ActiveCell.Offset(1, 0) = ""
End If