vba處理區課程彙總列表

期待效果

vba

Sub gettogether()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim count As Integer '學科個數
    Dim num_video As Integer
    k = 2
    Dim str1 As String '日期鏈接科目
    Dim str2 As String '學科
    Dim tmp As String '日期鏈接科目
    Dim flag As Boolean
    str1 = ""
    str2 = ""
    tmp = ""
    For j = 2 To 151 '最後加一條記錄
         tmp = Sheet1.Cells(j, 1) & Sheet1.Cells(j, 2)
         If tmp = str1 Then ' 大於等於第二個
           str2 = str2 + " " + Sheet1.Cells(j, 3)
           count = count + 1
           num_video = num_video + Sheet1.Cells(j, 4)
         Else '第一個新的
            Sheet1.Cells(k, 7) = Sheet1.Cells(j - 1, 1) '處理上一次的數據
            Sheet1.Cells(k, 8) = Sheet1.Cells(j - 1, 2) '處理上一次的數據
            Sheet1.Cells(k, 9) = "精品" '處理上一次的數據
            Sheet1.Cells(k, 10) = str2
            Sheet1.Cells(k, 11) = count
            Sheet1.Cells(k, 12) = num_video
            k = k + 1 '新的數據初始化
            str1 = tmp
            str2 = Sheet1.Cells(j, 3)
            count = 1
            num_video = Sheet1.Cells(j, 4)
         End If
    Next
End Sub