求整理杂乱的数据

陈11点

原先透视的数据因为年纪和班次不同，出现了很多行， 需要整理成第二图这样，因为有很多这样的，有的只出现过一次的

bqwd36

试着写了一个，反正就例子我运行了一下可以实现
Sub a()
Dim i%, j%
For i = 2 To Sheets(1).UsedRange.Rows.Count
    For j = 2 To 5
        With Sheets(1)
            If .Cells(i + 1, 1) = .Cells(i, 1) Then
                If .Cells(i, j) = "" Then
                    .Cells(i, j) = .Cells(i + 1, j)
                    .Cells(i + 1, j) = ""
                End If
            End If
        End With
    Next
Next
End Sub

bqwd36

~~~~~~~~~~

全党

Sub h()
Dim brr(1 To 200, 1 To 24), h
Set dic = CreateObject("Scripting.Dictionary")
arr = [a1].CurrentRegion
Range("i2:hz200").Clear
For i = 2 To UBound(arr, 2)
   For j = 2 To UBound(arr)
   If arr(j, i) <> "" Then
   dic(j & arr(j, 1) & arr(1, i)) = arr(j, i)
   End If
   Next
   k1 = dic.keys
   k = dic.items
   For h = 0 To dic.Count - 1
   brr(1, h + 1) = Mid(Trim(k1(h)), InStr(Trim(k1(h)), ",") + 1, InStr(Trim(k1(h)), "/") - InStr(Trim(k1(h)), ",") - 1)
   brr(i, h + 1) = k(h)
   Next
   dic.RemoveAll
Next
[i2].Resize(h, UBound(arr, 2)) = WorksheetFunction.Transpose(brr)
End Sub

太极拍天雄

仅针对当前表格测试。