气象，风向归纳成每天的hour的数据

dogfire4169

小白又来求教了。要把气象，归纳成每天的hour 最主要是column AB的风向的归纳,如图。之前又大大已经帮写了每月风向的归纳, 但是想再增加每天的hour的资料，想要改写，看了很多文，越看越胡涂。是本小白转不过来。

*****************************************************************
再解释一下，Sheet1的column AB 风向有N，S，E，W，NNW，NE。。。。 等不同的代号。目前1 HR 取样4次，我已经将column B 转成每小时0，1，2.。。。。到23 点，现再要归纳成每一天每小时的风向资料。如图。就这个风相搞不定。就用object dictionary 最容易搞定，用字典我就是个小白，请各位帮个忙。 多谢了

ykcbf1100

没看懂。。

dogfire4169

ykcbf1100 发表于 2023-3-1 10:43
没看懂。。

已经更新了说明，你再看看， thank you

dogfire4169

自己顶一下

dogfire4169

漂亮国求来的code，大家看看，别人的思路！！！

Sub TransformData()
   
    Const SRC_FIRST_CELL As String = "A1"
    Const DST_FIRST_CELL As String = "I1"
    Const DATE_COL As Long = 1
    Const HOUR_COL As Long = 2
    Const WIND_COL As Long = 3
    Const DH_DELIMITER As String = "|!|"
    Const WIND_DELIMITER As String = "/"
    Const COLUMNS_COUNT As Long = 3 ' fixed
   
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
   
    Dim srg As Range: Set srg = ws.Range(SRC_FIRST_CELL).CurrentRegion
    Dim srCount As Long: srCount = srg.Rows.Count
   
    Dim dData(): dData = srg.Columns(DATE_COL).Value
    Dim hData(): hData = srg.Columns(HOUR_COL).Value
    Dim wData(): wData = srg.Columns(WIND_COL).Value
   
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
   
    Dim r As Long, dString As String, wString As String
   
    For r = 2 To srCount
        dString = dData(r, 1) & DH_DELIMITER & hData(r, 1)
        If Not dict.Exists(dString) Then
            Set dict(dString) = CreateObject("Scripting.Dictionary")
        End If
        wString = wData(r, 1)
        dict(dString)(wString) = dict(dString)(wString) + 1
    Next r
   
    Dim drCount As Long: drCount = dict.Count + 1
   
    Dim Data(): ReDim Data(1 To drCount, 1 To COLUMNS_COUNT)
    Dim dLen As Long: dLen = Len(DH_DELIMITER)
   
    Data(1, 1) = dData(1, 1)
    Data(1, 2) = hData(1, 1)
    Data(1, 3) = wData(1, 1)
    r = 1
    wString = ""
   
    Dim oKey, iKey, dPos As Long, wMax As Long
   
    For Each oKey In dict.Keys
        r = r + 1
        dPos = InStr(oKey, DH_DELIMITER) - 1
        Data(r, 1) = CDate(Left(oKey, dPos))
        Data(r, 2) = CLng(Right(oKey, Len(oKey) - dPos - dLen))
        For Each iKey In dict(oKey).Keys
'            Debug.Print r, oKey, iKey, dict(oKey)(iKey)
            If dict(oKey)(iKey) > wMax Then
                wString = iKey
                wMax = dict(oKey)(iKey)
            ElseIf dict(oKey)(iKey) = wMax Then
                wString = wString & WIND_DELIMITER & iKey
            End If
        Next iKey
        Data(r, 3) = wString
'        Debug.Print Data(r, 1), Data(r, 2), Data(r, 3)
        wMax = 0
        wString = ""
    Next oKey
   
    With ws.Range(DST_FIRST_CELL).Resize(drCount, COLUMNS_COUNT)
        .CurrentRegion.ClearContents
        .Value = Data
    End With
   
    MsgBox "Data transformed.", vbInformation

End Sub

子容

用 SQL 解决分两步：
1.SELECT  DISTINT A,B FROM 表，剔除当日重复风向数据。
2.以A、B列进行分组，K列进行聚合操作 SELECT A,B,string_agg(K,'/') FROM 新表 GROUP BY A,B;,即可得到结果。

dogfire4169

子容 发表于 2023-3-4 08:17
用 SQL 解决分两步：
1.SELECT  DISTINT A,B FROM 表，剔除当日重复风向数据。
2.以A、B列进行分组，K列 ...

风向是同值的多，才是prevailing wind direction（应该翻译成 盛行风向） SQL 可能不容易，不能剔除当日重复风向数据。漂亮国求来的code是完全正确的。

Yalishanda30

dogfire4169 发表于 2023-3-4 18:57
风向是同值的多，才是prevailing wind direction（应该翻译成 盛行风向） SQL 可能不容易，不能剔除当日 ...

SQL可以去重，结果没看到有风向。。。。

Kaohsing

看这代码，有点像大神Lee1893的味道。

子容

Yalishanda30 发表于 2023-3-4 20:44
SQL可以去重，结果没看到有风向。。。。

select  distinct  a,b,k  from  表