Flatten Monthly data series

In recent data processing, the rainfall data collected in one place is arranged by month, as shown in the following table:

Station	Year	Type	Month	1	2	3	4	...	29	30	31
bj0030c	1961	Precip	01	0	0	0	0	...	0	0	0
bj0030c	1962	Precip	01	0	0	0	0	...	0	0	0
bj0030c	1963	Precip	01	0	0	0	0	...	0	0	0
bj0030c	1964	Precip	01	0	0	0	0	...	0	0	0
bj0030c	1965	Precip	01	0	0	0	0	...	0	0	0
bj0030c	1966	Precip	01	0	0	0	0	...	0	0	0
bj0030c	1967	Precip	01	0	0	0	0	...	0	0	0
bj0030c	1968	Precip	01	0	0	0	0	...	0	0	0
bj0030c	1969	Precip	01	0	0	0	0	...	0	0	0
bj0030c	1970	Precip	01	0	0	0	0	...	0	0	0

In order to get a daily data sequence, the following macro code is written:

 Public Subcombinedates ()DimWssrc asWorksheet, WsResult asWorksheetDimS1 as String, S2 as String    DimI as Integer    DimInvalidsheet as Boolean        SetWSSRC =ActiveSheet'Check Source FormatInvalidsheet =False    IfWssrc.cells (1,1). Text <>" Station"  ThenInvalidsheet =True    IfWssrc.cells (1,2). Text <>" Year"  ThenInvalidsheet =True    IfWssrc.cells (1,3). Text <>"Type"  ThenInvalidsheet =True    IfWssrc.cells (1,4). Text <>"Month"  ThenInvalidsheet =True     fori =1  to  to            IfWssrc.cells (1,4+ i). Text <> I ThenInvalidsheet =True    Next    IfInvalidsheet Then        MsgBox "Invalid source Sheet."& VbCrLf &"The first row of the sheet must be:"& VbCrLf & _            "Eg gh id,year,eg el abbreviation,month,1...31", vbcriticalExit Sub    End If    'Create The result sheetS1 = wssrc.name &"_RLT"     on Error Resume NextS2=S1 i=1     Do        SetWsResult = Nothing        SetWsResult =activeworkbook.sheets (S2)IfWsResult is  Nothing  Then Exit  DoS2= S1 &"("& I &")"I= i +1    Loop     on Error GoTo 0    SetWsResult =ActiveWorkbook.Sheets.Add (, wssrc) Wsresult.name=S2'ConvertWsresult.cells (1,1). Value =" Station"Wsresult.cells (1,2). Value ="Date"Wsresult.cells (1,3). Value =wssrc.name Wsresult.columns (2). ColumnWidth = A    DimRowidx as Long, ROWIDXRLT as Long, Curyear as Integer, Curmonth as IntegerRowidx=2ROWIDXRLT=2     while  notIsEmpty (Wssrc.cells (ROWIDX,1)) S1= Wssrc.cells (Rowidx,1). Text Curyear= Wssrc.cells (Rowidx,2). Value Curmonth= Wssrc.cells (Rowidx,4). Value fori =1  to  to            IfIsEmpty (Wssrc.cells (rowidx, i +4)) Then Exit  forwsresult.cells (ROWIDXRLT,1). Value =S1 wsresult.cells (ROWIDXRLT,2). Value =DateSerial(Curyear, Curmonth, i) wsresult.cells (ROWIDXRLT,3). Value = Wssrc.cells (rowidx, i +4). Value ROWIDXRLT= Rowidxrlt +1        NextRowidx= Rowidx +1WendMsgBox " in total"& (ROWIDXRLT-2) &"records were generated.", vbinformation,"Congratulation"End Sub

Flatten Monthly data series