白话Excel函数公式 Office易学宝微视频教程合集(Excel+Word+PPT)
笨办法学VBA(从入门到精通) 高效办公必会的Office实战技巧
财务总监的Excel私房课 Excel数据透视表实战秘技
Excel图表神技
楼主: leroy

一键汇总班级版块红花及登攀

  [复制链接]
发表于 2011-3-21 14:52:08 | 显示全部楼层
测试成功:victory:
回复 支持 反对

使用道具 举报

发表于 2011-3-23 08:39:02 | 显示全部楼层
我测试的时候为什么是没有登录呢!


会员登录       
用户名 UID         入学
密码         忘记密码
安全提问       
回答       
        会员登录
回复 支持 反对

使用道具 举报

 楼主| 发表于 2011-3-23 09:06:49 | 显示全部楼层
请在IE浏览器中登陆你的ID,然后进行测试。使用过程中,个别情况下可能需要重新登录。
回复 支持 反对

使用道具 举报

发表于 2011-3-23 09:52:26 | 显示全部楼层

回复 17楼 leroy 的帖子

我原来用的是谷歌浏览器,一直是登录状态,可是使用这个功能的时候 就需要登录提示
后来我改成IE登录后就OK了! 不错的功能! 学习。。。 待消化
回复 支持 反对

使用道具 举报

发表于 2011-4-1 19:16:16 | 显示全部楼层
回复 支持 反对

使用道具 举报

发表于 2011-4-5 15:30:44 | 显示全部楼层
回复 支持 反对

使用道具 举报

发表于 2011-4-28 12:35:15 | 显示全部楼层
  1. Dim WebUrl$, iT%

  2. Sub QueryTablesDownload()
  3.     Dim temp%                       '定义临时变量
  4.     Sheets("临时表").Cells.Clear        '清除临时表所有数据
  5.     WebUrl = [k1]                   '从统计表K1单元格获取网业地址
  6.     temp = InStrRev(Left(WebUrl, Len(WebUrl) - 7), "-")         '查找网业倒数第2个-字符位置
  7.     WebUrl = Left(WebUrl, temp) & Mid(Left(WebUrl, Len(WebUrl) - 7), temp + 1, 9) + iT & Right(WebUrl, 7)           '修改网业地址
  8.     With Sheets("临时表").QueryTables.Add(Connection:="URL;" & WebUrl, Destination:=Sheets("临时表").[$A$1])        '复制数据
  9.         .WebFormatting = xlWebFormattingNone                '去除格式
  10.         .Refresh                                            '将数据返回到工作表
  11.     End With
  12.     iT = iT + 1                                            '统计执行过程次数
  13.     If iT = 1 Then                                          '判断是否第一次执行过程
  14.         Columns("a:e").ClearContents                        '清除统计表A:E列数据
  15.         [a1:e1] = [{"用户名","楼层","登攀","红花","次数"}]  '为统计表添加表头
  16.     End If
  17. End Sub

  18. Sub CleaningValues()
  19.     On Error Resume Next                '容错代码
  20.     If Cells((iT - 1) * 10 + 1, 1) = "" And iT > 1 Then     '判断是否第二次或以上执行QueryTablesDownload过程返回的值是否有下一页
  21.         iT = 0                          '还原统计变量
  22.         MsgBox "当前位置为最后一页"         '提示为最后一页
  23.         Exit Sub                        '退出过程
  24.     End If
  25.     Dim i%, j%, sRow%, sRowRev%
  26.     sRowRev = Range("a65536").End(xlUp).Row         '获取统计表B列最后一行号
  27.     With Sheets("临时表")
  28.         sRow = .Range("b65536").End(xlUp).Row       '获取临时表B列最后一行号
  29.         For i = 1 To sRow Step 1                    '从临时表第1行遍历到最后一行
  30.             j = InStr(.Cells(i, 2), "楼 大 中 小 发表于")   '获取字符所在位置
  31.             If Right(.Cells(i, 2), 5) = "只看该作者" And j > 0 Then     '判断变量j是否大于和字符是否和单元格相等
  32.                 sRowRev = sRowRev + 1               '行号加1
  33.                 Cells(sRowRev, 1) = .Cells(i, 1)        '获取用户名
  34.                 Cells(sRowRev, 2) = Left(.Cells(i, 2), j - 1)       '获取楼层
  35.             End If
  36.         Next i
  37.     End With
  38.     Call AscendValues           '调用AscendValues过程
  39. End Sub

  40. Sub AscendValues()
  41.     Dim i%, j%, sRow%, floor%, floorRow%, startRow%
  42.     floorRow = -1: startRow = 1     '为初始变量赋值
  43.     On Error Resume Next            '容错代码
  44.     With Sheets("临时表")
  45.         sRow = .Range("b65536").End(xlUp).Row       '获取临时表B列最后一行号
  46.         For i = 1 To sRow Step 1                    '从临时表第1行遍历到最后一行
  47.             j = InStr(.Cells(i, 2), "楼 大 中 小 发表于")       '获取字符所在位置
  48.             If Right(.Cells(i, 2), 5) = "只看该作者" And j > 0 Then     '判断变量j是否大于和字符是否和单元格相等
  49.                 floor = Left(.Cells(i, 2), j - 1)                '获取楼层
  50.             End If
  51.             If InStr(.Cells(i, 2), " 登攀 ") > 0 Or InStr(.Cells(i, 2), " 红花 ") > 0 Then          '查找单元格中是否包涵登攀和红花字符
  52.                 Cells(floor + startRow, 3) = Cells(floor + startRow, 3) + Left(Mid(.Cells(i, 2), InStr(.Cells(i, 2), " 登攀 ") + 4, 9), _
  53.                                         InStr(Mid(.Cells(i, 2), InStr(.Cells(i, 2), " 登攀 ") + 4, 9), " ") - 1)                 '统计登攀
  54.                 Cells(floor + startRow, 4) = Cells(floor + startRow, 4) + Left(Mid(InStr(.Cells(i, 2), " 红花 ") + 4, 9), _
  55.                                         InStr(Mid(InStr(.Cells(i, 2), " 红花 ") + 4, 9), " "))              '统计红花
  56.                 Cells(floor + startRow, 5) = Cells(floor + startRow, 5) + 1                     '统计次数
  57.             End If
  58.         Next i
  59.     End With
  60.     Call QueryTablesDownload            '调用QueryTablesDownload过程
  61. End Sub

复制代码
获取网业数据-zhangjimfu.rar (29.6 KB, 下载次数: 17)

评分

参与人数 1登攀 +20 收起 理由
leroy + 20 感谢阿发的辛苦付出!

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2011-5-6 16:03:24 | 显示全部楼层
拥抱一下:hug: 做得真是太好了!!感激得热泪盈眶啊……
回复 支持 反对

使用道具 举报

发表于 2011-5-9 18:10:36 | 显示全部楼层
太方便了,谢谢馒头老师,收藏了
回复 支持 反对

使用道具 举报

发表于 2011-5-9 18:23:32 | 显示全部楼层
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 入学

本版积分规则

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