会excel vba的朋友进——请问图中数据如何自动汇总

前提：1年份很多，且中间有空白数据段——无法手工删除
每年的词汇数据很长——手工复制几乎不能完成
2年份项个数不定，每年的词汇数据（即纵向数列）个数也不定
3词汇并非英文，这里用字母代替
希望达到：如右边黄颜色的数据排列，年份+词汇

具体文件http://yun.baidu.com/share/link?shareid=2340398684&uk=923218174

希望有编程高手相助，，跪谢加分

推荐答案推荐于2016-03-15

Sub myfun()
    Application.ScreenUpdating = False    '不更新屏幕，在数据量比较大的时候，效率提升
    n = Range("zz1").End(xlToLeft).Column  '取得第一行最后有数据的列号
    k = 2
    For i = 1 To n
        If Cells(2, i) <> "" Then           '取列数据
            m = Range(Chr(i + 64) & "65535").End(xlUp).Row - 1 '取得数据列的行数
            Range(Cells(k, n + 1), Cells(k + m - 1, n + 1)).Value = Cells(1, i) '在n+1列填入年份
            Range(Cells(k, n + 2), Cells(k + m - 1, n + 2)).Value = Range(Cells(2, i), Cells(m + 1, i)).Value '在n+2列填入数据
            k = k + m  '计算下一列数据填入的位置
        End If
    Next
    Application.ScreenUpdating = True
End Sub

追问

追答

不好意思，没有考虑列大于z，我再修改一下

Sub myfun()
    Application.ScreenUpdating = False    '不更新屏幕，在数据量比较大的时候，效率提升
    n = Range("zz1").End(xlToLeft).Column  '取得第一行最后有数据的列号
    k = 2
    For i = 1 To n
        If Cells(2, i) <> "" Then           '取列数据
            m = Range(Cells(65535, i),Cells(65535, i)).End(xlUp).Row - 1 '取得数据列的行数
            Range(Cells(k, n + 1), Cells(k + m - 1, n + 1)).Value = Cells(1, i) '在n+1列填入年份
            Range(Cells(k, n + 2), Cells(k + m - 1, n + 2)).Value = Range(Cells(2, i), Cells(m + 1, i)).Value '在n+2列填入数据
            k = k + m  '计算下一列数据填入的位置
        End If
    Next
    Application.ScreenUpdating = True
End Sub

追问

竖列有6000+列，你的公式只能收集（汇整）前670列，后面的全部都没统计

（PS：这里的列数包括空白列，只是空白列不贡献词语）

追答

额，没想到你这么多列，n = Range("zz1").End(xlToLeft).Column 改成：
n=Range(Cells(1, 10000), Cells(1, 10000)).End(xlToLeft).Column ‘多于10000列的话改10000

追问