首页 > 代码库 > 拼合逐月数据系列
拼合逐月数据系列
近期数据处理中搜集到一个地方的降雨数据按月排列,如下表所示:
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 |
为了得到逐日的数据序列,编写了以下宏代码:
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
拼合逐月数据系列
声明:以上内容来自用户投稿及互联网公开渠道收集整理发布,本网站不拥有所有权,未作人工编辑处理,也不承担相关法律责任,若内容有误或涉及侵权可进行投诉: 投诉/举报 工作人员会在5个工作日内联系你,一经查实,本站将立刻删除涉嫌侵权内容。