ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 13744|回复: 35

[求助]按姓名笔画排序?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2008-2-2 11:45 | 显示全部楼层 |阅读模式

现在这个宏要对该区域(比如A1:A8)选择2次。

如何才能做到用鼠标选择一次某区域,对所选区域进行排序,然后按原来的分布把排序结果写回去?


 

v9deUC1z.rar (7.66 KB, 下载次数: 90)
[此贴子已经被作者于2008-2-2 14:25:28编辑过]

eoJj7DW8.rar

7.62 KB, 下载次数: 70

[求助]按姓名笔画排序?

TA的精华主题

TA的得分主题

发表于 2008-2-2 16:58 | 显示全部楼层

如何才能做到用鼠标选择一次某区域,对所选区域进行排序,然后按原来的分布把排序结果写回去?

----------------------------------

好难懂.

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-2-2 20:29 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
QUOTE:
以下是引用northwolves在2008-2-2 16:58:05的发言:

好难懂.

OK,做到了,就是如下附件的意思! 不知道还有什么更好的方法?

btw:有点不明白,为什么“区”会排在“王”的前面?

 

utzunmhp.rar (10.4 KB, 下载次数: 66)
[此贴子已经被作者于2008-2-2 20:33:42编辑过]

TA的精华主题

TA的得分主题

发表于 2008-2-4 18:49 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

回复:(hzynew)[求助]按姓名笔画排序?

供参考。

hzynew_按姓名笔画排序.rar

65.77 KB, 下载次数: 233

回复:(hzynew)[求助]按姓名笔画排序?

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-2-5 10:44 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2008-2-5 16:24 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

感谢!

[此贴子已经被作者于2008-3-4 20:31:52编辑过]

TA的精华主题

TA的得分主题

发表于 2008-2-8 09:38 | 显示全部楼层

为什么我的文件只能点击菜单下的宏才能执行?请教!

z75ETA6e.rar (66.04 KB, 下载次数: 53)

TA的精华主题

TA的得分主题

发表于 2008-2-8 13:02 | 显示全部楼层
QUOTE:
以下是引用山菊花在2008-2-4 18:49:44的发言:


Public ds
Sub 整理()
    On Error Resume Next
    Dim ary(), arr As Range, c As Range, c2 As Range, cAddress$
    Application.EnableEvents = False
   
    If TypeName(ds) = "Empty" Then
        Dim nRow%, m%
       
        Set ds = CreateObject("scripting.dictionary") '定义字典
        nRow = Sheets("笔画库").[a65536].End(xlUp).Row
        hanzi = Sheets("笔画库").Range("a1:a" & nRow)
       
        For i = 1 To nRow '把汉字添加到字典中
            ds.Add hanzi(i, 1), m + 1
            If Err.Number = 0 Then
                m = m + 1
            End If
            Err.Clear
        Next
    End If
   
   
    cAddress = Selection.Address
    Set arr = Application.InputBox(Prompt:="说明:" & vbCrLf & vbNewLine & "所选区域将依照姓名笔划顺序按原布局重新调整。", Title:="选择要排序的区域 ... ...", Type:=8, Default:=cAddress)
   
    Application.ScreenUpdating = False
   
    If arr Is Nothing Then: Exit Sub
   
    p = Application.WorksheetFunction.CountA(arr)
   
    ReDim ary(1 To p, 1 To 2)
   
    For Each c2 In arr
        If c2 <> "" Then
            k = k + 1
            ary(k, 1) = c2
           
            For m = 1 To Len(c2)
                If m > 4 Or Mid(c2, m, 1) = "(" Then Exit For
                ary(k, 2) = ary(k, 2) + ds(Mid(c2, m, 1)) * 10000 ^ (4 - m)
            Next
           
        End If
    Next
   
    Range("iu1:iv" & p) = ary
   
    Columns("IU:IV").Sort Key1:=Range("IV1"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
            :=xlStroke, DataOption1:=xlSortNormal
    k = 0
    For i = 1 To arr.Rows.Count
        For j = 1 To arr.Columns.Count
            If arr(i, j) <> "" Then: k = k + 1: arr(i, j) = Range("iu" & k)
        Next j
    Next i
   
    Range("iu1:iv" & k).ClearContents
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

学习了,很多方面知识的综合运用阿!

TA的精华主题

TA的得分主题

发表于 2008-2-8 13:21 | 显示全部楼层

以上代码加到了我的附件上,用按钮运行依然还是得不到正确结果,在工具菜单中选择宏来运行则可以。

很想知道原因。

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-2-8 14:47 | 显示全部楼层

山菊花超版,能不能再修改一下:让表格中的“单字”名 与 “Bhpm自定义函数”一样——姓名之间不论有没有空格都排在前面(如:“王二” 与 “王  二”一样都排在“王一二”前面)。

[此贴子已经被作者于2008-2-10 16:09:01编辑过]

6t1sMufY.rar

129 KB, 下载次数: 61

[求助]按姓名笔画排序?

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

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 10:07 , Processed in 0.050715 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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