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

路也Orz 2020-04-15 05:13:09
有这样的一份任课表,如图1,想把它处理成图2这样的格式,有没有什么快捷的方法可以实现呢?函数或者VBA?跪求大神指导
...全文
284 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
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
  • 打赏
  • 举报
回复
选中格子区域,复制,到空白目标区域,右键,选择性粘贴,行列转置

2,461

社区成员

发帖
与我相关
我的任务
社区描述
VBA(Visual Basic for Applications)是Visual Basic的一种宏语言,是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。
社区管理员
  • VBA
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧