excel中有没有什么办法把一个人的多项数据处理成一行多列?

路也Orz 华南师范大学 2020-04-15 05:13:09
有这样的一份任课表,如图1,想把它处理成图2这样的格式,有没有什么快捷的方法可以实现呢?函数或者VBA?跪求大神指导
...全文
58 点赞 收藏 7
写回复
7 条回复
milaoshu1020 2020年04月16日
写好了,代码如下:

Option Explicit

Sub 多项数据处理成一行多列()
    Dim dict As Object
    Set dict = CreateObject("scripting.dictionary")
    
    Dim i As Long
    i = 3
    
    Do While Sheet1.Cells(i, 1) <> ""
        Dim j As Long
        For j = 3 To 16
            If Sheet1.Cells(i, j) <> "" Then
                Dim strKey As String
                strKey = Sheet1.Cells(i, j) & "," & Sheet1.Cells(i, 1) & "," & Sheet1.Cells(1, j)
                
                Dim strValue As String
                strValue = Sheet1.Cells(i, 2)
                
                If dict.exists(strKey) Then
                    dict.Item(strKey) = dict.Item(strKey) & "," & strValue
                Else
                    dict.Add strKey, strValue
                End If
            End If
        Next
        i = i + 1
    Loop
    
    i = 2
    Dim varKey As Variant
    For Each varKey In dict
        Dim arrKey() As String
        arrKey = Split(varKey, ",")
        
        Sheet2.Cells(i, 1) = arrKey(0)
        Sheet2.Cells(i, 2) = arrKey(1)
        Sheet2.Cells(i, 3) = dict(varKey)
        Sheet2.Cells(i, 4) = arrKey(2)
        
        i = i + 1
    Next
    
    MsgBox "done!"
End Sub
下载地址: 链接:https://pan.baidu.com/s/1_jpRGo3wd_nkunIJ7JON9A 提取码:riqz 运行示例:
回复 点赞
milaoshu1020 2020年04月16日
备课的怎么处理?
回复 点赞
路也Orz 2020年04月16日
引用 2 楼 milaoshu1020 的回复:
建议把xls文件上传到百度网盘,点击共享,把共享代码贴在这里;
谢谢提醒!下面这个链接是数据的文档,想把任课表处理成每个老师单独一行,然后分列对应他所教的所有班级、所教的科目还有所教的年级这样的形式。 链接: https://pan.baidu.com/s/1ruRf8u0cPv-vT3hw5W5PQw 提取码: eqri
回复 点赞
路也Orz 2020年04月16日
下面这个链接是数据的文档,想把任课表处理成每个老师单独一行,然后分列对应他所教的所有班级、所教的科目还有所教的年级这样的形式。 链接: https://pan.baidu.com/s/1ruRf8u0cPv-vT3hw5W5PQw 提取码: eqri
回复 点赞
milaoshu1020 2020年04月16日
建议把xls文件上传到百度网盘,点击共享,把共享代码贴在这里;
回复 点赞
路也Orz 2020年04月16日
引用 6 楼 milaoshu1020的回复:
写好了,代码如下:

Option Explicit

Sub 多项数据处理成一行多列()
    Dim dict As Object
    Set dict = CreateObject("scripting.dictionary")
    
    Dim i As Long
    i = 3
    
    Do While Sheet1.Cells(i, 1) <> ""
        Dim j As Long
        For j = 3 To 16
            If Sheet1.Cells(i, j) <> "" Then
                Dim strKey As String
                strKey = Sheet1.Cells(i, j) & "," & Sheet1.Cells(i, 1) & "," & Sheet1.Cells(1, j)
                
                Dim strValue As String
                strValue = Sheet1.Cells(i, 2)
                
                If dict.exists(strKey) Then
                    dict.Item(strKey) = dict.Item(strKey) & "," & strValue
                Else
                    dict.Add strKey, strValue
                End If
            End If
        Next
        i = i + 1
    Loop
    
    i = 2
    Dim varKey As Variant
    For Each varKey In dict
        Dim arrKey() As String
        arrKey = Split(varKey, ",")
        
        Sheet2.Cells(i, 1) = arrKey(0)
        Sheet2.Cells(i, 2) = arrKey(1)
        Sheet2.Cells(i, 3) = dict(varKey)
        Sheet2.Cells(i, 4) = arrKey(2)
        
        i = i + 1
    Next
    
    MsgBox "done!"
End Sub
下载地址: 链接:https://pan.baidu.com/s/1_jpRGo3wd_nkunIJ7JON9A 提取码:riqz 运行示例:
大神👍🏻👍🏻👍🏻
回复 点赞
vansoft 2020年04月15日
选中格子区域,复制,到空白目标区域,右键,选择性粘贴,行列转置
回复 点赞
发动态
发帖子
VBA
创建于2007-09-28

1576

社区成员

1.0w+

社区内容

VBA(Visual Basic for Applications)是Visual Basic的一种宏语言,是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。
社区公告
暂无公告