Excel精英培训网

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

[已解决]求助数组高手帮我把这几张英语单词表中的单词改变排列顺序

[复制链接]
发表于 2014-8-31 07:05 | 显示全部楼层 |阅读模式
通过点击“提取单词”按钮依次将sheet1右边的3张单词表(实际有六十多张)中的单词按照“一行一行”的顺序把“英语单词”和对应的“中文意思”分别按纵向,首尾相接地放入sheet1的A列和B列中。单词表可能不完整,其中还有合并单元格。另外在每个单词表中的单词提取过来后,在首个单词的C列写入该单词表的标题,如“英语单词表(七)”,这样做的最终目的是想利用excel的“字典”功能快速查找英语单词。详见附件:
提取单词.rar (57.64 KB, 下载次数: 10)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2014-8-31 08:11 | 显示全部楼层
  1. Sub Macro1()
  2. Dim arr, brr(1 To 60000, 1 To 3), i%, j&, k%, s&
  3. For i = 1 To Sheets.Count
  4.     If Sheets(i).Name <> "Sheet1" Then
  5.         arr = Sheets(i).UsedRange
  6.         For j = 2 To UBound(arr) Step 2
  7.             For k = 1 To UBound(arr, 2)
  8.                 If arr(j, k) <> "" Then
  9.                     s = s + 1: brr(s, 1) = arr(j, k): brr(s, 2) = arr(j + 1, k)
  10.                 End If
  11.                 If j = 2 And k = 1 Then brr(s, 3) = arr(1, 1)
  12.             Next
  13.         Next
  14.     End If
  15. Next
  16. Range("a1").Resize(s, 3) = brr
  17. End Sub
复制代码
回复

使用道具 举报

发表于 2014-8-31 08:12 | 显示全部楼层
用不着字典

提取单词.zip

27.99 KB, 下载次数: 13

回复

使用道具 举报

 楼主| 发表于 2014-8-31 09:03 | 显示全部楼层
dsmch 发表于 2014-8-31 08:12
用不着字典

首先表示非常感谢,初步看了一下,发些一些重复的,如第一张表里的单词 air ,不知道怎么回事?

点评

07表,[q30]单元格  发表于 2014-8-31 09:11
回复

使用道具 举报

 楼主| 发表于 2014-8-31 09:05 | 显示全部楼层
dsmch 发表于 2014-8-31 08:12
用不着字典

我这样做,是想把这些单词提取出来后,将来用“字典”功能查询其中的某个单词

点评

原来顺序也可以用字典来处理  发表于 2014-8-31 09:13
回复

使用道具 举报

 楼主| 发表于 2014-8-31 09:26 | 显示全部楼层
dsmch 发表于 2014-8-31 08:12
用不着字典

怎么回事?07表,[q30]单元格 重复 ,其他表也有很多重复
回复

使用道具 举报

发表于 2014-8-31 09:40 | 显示全部楼层    本楼为最佳答案   
可以用字典的去重功能
  1. Sub Macro1()
  2. Dim arr, brr(1 To 60000, 1 To 3), d, i%, j&, k%, s&
  3. Set d = CreateObject("scripting.dictionary")
  4. For i = 1 To Sheets.Count
  5.     If Sheets(i).Name <> "Sheet1" Then
  6.         arr = Sheets(i).UsedRange
  7.         For j = 2 To UBound(arr) Step 2
  8.             For k = 1 To UBound(arr, 2)
  9.                 If arr(j, k) <> "" And Not d.exists(arr(j, k)) Then
  10.                     s = s + 1: d(arr(j, k)) = "": brr(s, 1) = arr(j, k): brr(s, 2) = arr(j + 1, k)
  11.                 End If
  12.                 If j = 2 And k = 1 Then brr(s, 3) = arr(1, 1)
  13.             Next
  14.         Next
  15.     End If
  16. Next
  17. Range("a1").Resize(s, 3) = brr
  18. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
jessylake + 3 很给力!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2014-8-31 09:48 | 显示全部楼层
dsmch 发表于 2014-8-31 09:40
可以用字典的去重功能

谢谢,我也发现了,是英语表的合并单元格有问题,重新合并一下就好了
回复

使用道具 举报

发表于 2014-8-31 16:56 | 显示全部楼层
短信收到,代码稍微修改即可用字典查询
Sub Macro1()
Dim arr, brr(1 To 60000, 1 To 3), d, i%, j&, k%, s&
Set d = CreateObject("scripting.dictionary")
For i = 1 To Sheets.Count
    If Sheets(i).Name <> "Sheet1" Then
        arr = Sheets(i).UsedRange
        For j = 2 To UBound(arr) Step 2
            For k = 1 To UBound(arr, 2)
                If arr(j, k) <> "" And Not d.exists(arr(j, k)) Then
                    s = s + 1: d(arr(j, k)) = arr(j + 1, k): brr(s, 1) = arr(j, k): brr(s, 2) = arr(j + 1, k)
                End If
                If j = 2 And k = 1 Then brr(s, 3) = arr(1, 1)
            Next
        Next
    End If
Next
Range("a1").Resize(s, 3) = brr
End Sub
回复

使用道具 举报

 楼主| 发表于 2014-8-31 17:13 | 显示全部楼层
dsmch 发表于 2014-8-31 16:56
短信收到,代码稍微修改即可用字典查询
Sub Macro1()
Dim arr, brr(1 To 60000, 1 To 3), d, i%, j&, k%, ...

老师您能帮我把这段代码写到我的    求助字典高手帮我做个英语单词查询
http://www.excelpx.com/thread-331078-1-1.html  里面的窗体里吗,我不知道窗体怎么建立,因为要发音所以还要把地址提取成一段字符串,谢谢了,再帮帮我把,我不知道怎么弄窗体

点评

舍近求远,帮你是误导你。  发表于 2014-8-31 17:20
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 06:13 , Processed in 0.401515 second(s), 16 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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