首页 > 代码库 > 拼合逐月数据系列

拼合逐月数据系列

近期数据处理中搜集到一个地方的降雨数据按月排列,如下表所示:

StationYearTypeMonth1234293031
BJ0030C1961Precip010000000
BJ0030C1962Precip010000000
BJ0030C1963Precip010000000
BJ0030C1964Precip010000000
BJ0030C1965Precip010000000
BJ0030C1966Precip010000000
BJ0030C1967Precip010000000
BJ0030C1968Precip010000000
BJ0030C1969Precip010000000
BJ0030C1970Precip010000000

为了得到逐日的数据序列,编写了以下宏代码:

Public Sub CombineDates()    Dim wsSrc As Worksheet, wsResult As Worksheet    Dim s1 As String, s2 As String    Dim i As Integer    Dim InvalidSheet As Boolean        Set wsSrc =http://www.mamicode.com/ ActiveSheet    Check source format    InvalidSheet = False    If wsSrc.Cells(1, 1).Text <> "Station" Then InvalidSheet = True    If wsSrc.Cells(1, 2).Text <> "Year" Then InvalidSheet = True    If wsSrc.Cells(1, 3).Text <> "Type" Then InvalidSheet = True    If wsSrc.Cells(1, 4).Text <> "Month" Then InvalidSheet = True    For i = 1 To 31            If wsSrc.Cells(1, 4 + i).Text <> i Then InvalidSheet = True    Next    If InvalidSheet 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", vbCritical        Exit Sub    End If    Create the result sheet    s1 = wsSrc.Name & "_Rlt"    On Error Resume Next    s2 = s1    i = 1    Do        Set wsResult = Nothing        Set wsResult = ActiveWorkbook.Sheets(s2)        If wsResult Is Nothing Then Exit Do        s2 = s1 & "(" & i & ")"        i = i + 1    Loop    On Error GoTo 0    Set wsResult = ActiveWorkbook.Sheets.Add(, wsSrc)    wsResult.Name = s2        Convert    wsResult.Cells(1, 1).Value = http://www.mamicode.com/"Station"    wsResult.Cells(1, 2).Value = http://www.mamicode.com/"Date"    wsResult.Cells(1, 3).Value =http://www.mamicode.com/ wsSrc.Name    wsResult.Columns(2).ColumnWidth = 12    Dim rowIdx As Long, rowIdxRlt As Long, curYear As Integer, curMonth As Integer    rowIdx = 2    rowIdxRlt = 2    While Not IsEmpty(wsSrc.Cells(rowIdx, 1))        s1 = wsSrc.Cells(rowIdx, 1).Text        curYear = wsSrc.Cells(rowIdx, 2).Value        curMonth = wsSrc.Cells(rowIdx, 4).Value        For i = 1 To 31            If IsEmpty(wsSrc.Cells(rowIdx, i + 4)) Then Exit For            wsResult.Cells(rowIdxRlt, 1).Value =http://www.mamicode.com/ s1            wsResult.Cells(rowIdxRlt, 2).Value = http://www.mamicode.com/DateSerial(curYear, curMonth, i)            wsResult.Cells(rowIdxRlt, 3).Value = http://www.mamicode.com/wsSrc.Cells(rowIdx, i + 4).Value            rowIdxRlt = rowIdxRlt + 1        Next        rowIdx = rowIdx + 1    Wend    MsgBox "In total " & (rowIdxRlt - 2) & " records were generated.", vbInformation, "Congratulation"End Sub

 

拼合逐月数据系列