Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2741|回复: 3

[已解决]提取不重复内容

[复制链接]
发表于 2016-7-25 15:47 | 显示全部楼层 |阅读模式
本帖最后由 武林长风 于 2016-7-26 22:30 编辑

分别在一到六年级工作表的B列,提取不重复的学校年班名,(学校年班这四个字不提取) 新建文件夹.rar (86 Bytes, 下载次数: 4)
 楼主| 发表于 2016-7-25 20:09 | 显示全部楼层
本帖最后由 武林长风 于 2016-7-26 22:30 编辑

提取后,每个年级之间隔一列,用公式做相关的计算。
回复

使用道具 举报

发表于 2016-7-25 21:56 | 显示全部楼层    本楼为最佳答案   
  1. Sub wanao()
  2.     Dim eX As Integer, a As Integer, arr
  3.     Set dic = CreateObject("Scripting.Dictionary")
  4.     For i = 1 To 6
  5.         Sheets(i).Activate
  6.         eX = Cells(Rows.Count, 2).End(xlUp).Row
  7.         For x = 2 To eX
  8.             If Cells(x, 2) <> "学校年班" Then dic(Cells(x, 2).Value) = ""
  9.         Next
  10.     Next
  11.     Sheet7.Activate
  12.     a = 0
  13.     arr = dic.keys
  14.     For x = 2 To dic.Count \ 3 + 1
  15.         For y = 1 To 5 Step 2
  16.             Cells(x, y) = arr(a)
  17.             a = a + 1
  18.         Next
  19.     Next
  20. End Sub
复制代码

评分

参与人数 1 +9 收起 理由
武林长风 + 9 很给力

查看全部评分

回复

使用道具 举报

发表于 2016-7-25 22:45 | 显示全部楼层
Sub 提取不重复信息()
    Dim dic As Object, dic1 As Object, Dim arr(), i As Integer, iSh As Integer, j As Integer
    Set dic = CreateObject("scripting.Dictionary")
    Set dic1 = CreateObject("scripting.Dictionary")
    For i = 1 To Sheets.Count
        dic1(Sheet7.Cells(1, i).Value) = i
    Next i
    For iSh = 1 To Sheets.Count
        With Sheets(iSh)
            If dic1.Exists(.Name) = True Then
                iRows = .Range("B" & .Rows.Count).End(xlUp).Row
                arr = .Range("B1").Resize(iRows).Value
                For j = 1 To iRows
                    If arr(j, 1) <> "学校年班" Then dic(arr(j, 1)) = ""
                Next j
                Cells(2, dic1(.Name)).Resize(dic.Count, 1).Value = Application.Transpose(dic.Keys)
                Erase arr
                dic.RemoveAll
            End If
        End With
    Next iSh
End Sub

“六年级”那个sheet名字多了个空格,删掉即可

评分

参与人数 1 +9 收起 理由
武林长风 + 9 神马都是浮云

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 15:11 , Processed in 0.414782 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表