Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

你正在寻找更好的Excel学习教程吗?Excel技巧80集+数据透视表+函数初中高全套+VBA80集,想学的这儿全都有
查看: 435|回复: 11

[求助] 求助,大神过来帮忙看看,有没有好方法

[复制链接]
发表于 2017-6-2 10:16 | 显示全部楼层 |阅读模式
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
求助,大神过来帮忙看看,有没有好方法 33333.rar (6.49 KB, 下载次数: 14)
123.jpg
发表于 2017-6-2 12:47 | 显示全部楼层
用VBA做的,结果生成在G1,试试o不o把!
  1. Sub test()
  2.     Dim d As Object
  3.     Dim ar, br(1 To 10000, 1 To 100)
  4.     Dim i As Long, j As Long, k As Long
  5.     Set d = CreateObject("scripting.dictionary")
  6.     ar = Cells(1, 1).CurrentRegion
  7.     br(1, 1) = ar(1, 1): br(1, 2) = "输出": j = 1
  8.     For i = 2 To UBound(ar)
  9.         If d.exists(ar(i, 1)) Then
  10.             d(ar(i, 1)) = Array(d(ar(i, 1))(0), d(ar(i, 1))(1) + 1)
  11.             If d(ar(i, 1))(1) > k Then k = d(ar(i, 1))(1)
  12.             br(d(ar(i, 1))(0), d(ar(i, 1))(1)) = ar(i, 2)
  13.         Else
  14.             j = j + 1
  15.             d.Add ar(i, 1), Array(j, 2)
  16.             br(j, 1) = ar(i, 1)
  17.             br(j, 2) = ar(i, 2)
  18.         End If
  19.     Next i
  20.     With Cells(1, 7)
  21.         .Resize(Rows.Count, k).ClearContents
  22.         .Resize(j, k) = br
  23.     End With
  24. End Sub
复制代码


test.zip

11.49 KB, 下载次数: 4

回复 支持 反对

使用道具 举报

发表于 2017-6-5 11:25 | 显示全部楼层
辅助列+数据透视表:

Copy of 33333.zip

9.54 KB, 下载次数: 3

回复 支持 反对

使用道具 举报

发表于 2017-6-5 11:29 | 显示全部楼层
C2=IF($A2=$A3,B3&"","")

右拉下拉公式,看看公式结果。
回复 支持 反对

使用道具 举报

发表于 2017-6-9 09:43 | 显示全部楼层
INDEX+SAMLL+IF+ROW+Colum 组合,非常好用也强大,希望有帮助。

33333.rar

7.13 KB, 下载次数: 1

回复 支持 反对

使用道具 举报

发表于 2017-6-9 10:07 | 显示全部楼层
windyjw007 发表于 2017-6-2 12:47
用VBA做的,结果生成在G1,试试o不o把!

你好!可否把程序修改下,以适应上网行的查询(最好没有行数限制)。
回复 支持 反对

使用道具 举报

发表于 2017-6-9 10:08 | 显示全部楼层
windyjw007 发表于 2017-6-2 12:47
用VBA做的,结果生成在G1,试试o不o把!

你好!可否把程序修改下,以适合上万行的查询(最好没有行数限制)。在线等,谢谢
回复 支持 反对

使用道具 举报

发表于 2017-6-9 10:13 | 显示全部楼层
nyh04 发表于 2017-6-9 10:07
你好!可否把程序修改下,以适应上网行的查询(最好没有行数限制)。

那你把br(1 To 10000, 1 To 100)改成br(1 To 100000, 1 To 100)吧
再大,Excel估计也不支持了吧!
回复 支持 反对

使用道具 举报

发表于 2017-6-9 10:27 | 显示全部楼层
nyh04 发表于 2017-6-9 10:08
你好!可否把程序修改下,以适合上万行的查询(最好没有行数限制)。在线等,谢谢

Sub text()
Dim arr As Variant, hh As Long
arr = Range("a2").CurrentRegion
For hh = 2 To UBound(arr)
If Cells(Cells(Rows.Count, 1).End(3).Row, 1).Value = arr(hh, 1) Then
Cells(Cells(Rows.Count, 1).End(3).Row, 1).End(xlToRight).Offset(0, 1).Value = arr(hh, 2)
Else
Cells(Cells(Rows.Count, 1).End(3).Row + 1, 1).Value = arr(hh, 1)
Cells(Cells(Rows.Count, 1).End(3).Row, 1).Offset(0, 1).Value = arr(hh, 2)
End If
Next
End Sub

回复 支持 反对

使用道具 举报

发表于 2017-6-9 14:27 | 显示全部楼层
好像还是不行,谢谢
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2017-8-21 23:45 , Processed in 0.109201 second(s), 26 queries , Gzip On, Memcache On.

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

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