jackcsm的博客

最近研究了下关于提取EXECL单元格中提取特殊字符的问题，经过一些EXECL共同爱好者（LearningHard）的帮助，终于问题迎刃而解，请各位看官欣赏。 原始单元格： 871-30233中文-KE1-01-01&A字符FDDF显示吧+ABC 按以下要求提取字符 提取中文字 ：中文字符显示吧 提取英文字 ：KEAFDDFABC 提取数字 ：8713023310101 提取特殊字 ：----&+ 提取非中文字：871-30233-KE1-01-01&AFDDF;+ABC 提取特殊字和英文字：--KE--&AFDDF;+ABC 此方法是通过VBA功能来实现的，以下是VBA代码： ' 提取中文 Function Chinese(text As String) Dim tempchar, tempname, n, i Dim bol As Boolean n = Len(text) For i = 1 To n tempchar = Mid(text, i, 1) bol = Asc(tempchar) < 0 If bol = True Then tempname = tempname & tempchar End If Next i If tempname = 0 Then tempname = "N/A" Chinese = tempname End Function ' 提取非中文 Function NoChinese(text As String) Dim tempchar, tempname, n, i Dim bol As Boolean n = Len(text) For i = 1 To n tempchar = Mid(text, i, 1) bol = Asc(tempchar) > 0 If bol = True Then tempname = tempname & tempchar End If Next i If tempname = 0 Then tempname = "N/A" NoChinese = tempname End Function '提取数字 Function Number(text As String) Dim tempchar, tempname, n, i Dim bol As Boolean n = Len(text) For i = 1 To n tempchar = Mid(text, i, 1) bol = tempchar Like "#" If bol = True Then tempname = tempname & tempchar End If Next i If tempname = 0 Then tempname = "N/A" Number = Val(tempname) End Function '提取英文字母 Function letter(text As String) Dim tempchar, tempname, n, i Dim bol As Boolean n = Len(text) For i = 1 To n tempchar = Mid(text, i, 1) bol = tempchar Like "[a-z,A-Z]" If bol = True Then tempname = tempname & tempchar End If Next i If tempname = 0 Then tempname = "N/A" letter = tempname End Function ' 提取特殊字符 Function SpecialChar(text As String) Dim tempchar, tempname, n, i Dim bol As Boolean n = Len(text) For i = 1 To n tempchar = Mid(text, i, 1) bol = Asc(tempchar) < 0 Or tempchar Like "[a-z,A-Z]" Or tempchar Like "#" If bol = False Then tempname = tempname & tempchar End If Next i If tempname = 0 Then tempname = "N/A" SpecialChar = tempname End Function ' 提取特殊字符和英文字母 Function SpecialCharandletter(text As String) Dim tempchar, tempname, n, i Dim bol As Boolean n = Len(text) For i = 1 To n tempchar = Mid(text, i, 1) bol = Asc(tempchar) < 0 Or tempchar Like "#" If bol = False Then tempname = tempname & tempchar End If Next i If tempname = 0 Then tempname = "N/A" SpecialCharandletter = tempname End Function 已上传execl附件

采购同事遇到新的问题了，他来找到我，需要我给他设计一个，采购进度管理的表格，要求是他每次录入完或者修改完数据后，自动把采购完成的项目下移动到最后，让那些还没采购完成的项目始终排在最上面的行。这样他可以方便他的日常采购进度的追踪。 问题既然提出来了，我就要尽最大的努力来帮助同事。 1.首先我认为要自动把采购完成的项目下移到最后的话，其实不怎么科学，应该是把采购完成的项目移动到最上面才是科学的，因为要录入新的项目，在最后插入是最方便的，在中间或者最上面插入比较麻烦。 2.我就想到排序的方法可以实现让采购完成的项目移动到最上面。 于是我查阅了一些vba实现execl的自动排序，最终编写好的代码如下（请下载相应的附件execl表格，这样比较容易理解）： Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 9 And Target.Column <> 8 And Target.Column <> 7 Or Target.Count > 1 Then Exit Sub On Error Resume Next Range("A2:I999").Sort Key1:=Range("I1"), Order1:=xlAscending, Key2:=Range("H1") _ , Order2:=xlAscending, Key3:=Range("G1") _ , Order3:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _ xlSortNormal, DataOption2:=xlSortNormal End Sub ps：在设计过程中，还进行了进一步的改进，例如：采购进度其实排序关键字段不是只有一个关键字段，而牵涉到3个之多。当然第一关键字还是采购完成日期，后面2个排序关键字段也是能起到追踪进度的作用的。另还加入了数据有效性的设计，让采购进度录入更方便，规范。

遇到一个问题是这样的：有个做采购的同事，他来找到我，让我给他设计一个execl表格，能完成它日常采购东西的流水账，要求是能够自动输入当天日期和时间。 然后我开始分析这个问题，用=now（）这个函数能够做到自动获得当前日期和时间，但是问题在于怎么触发它，于是我有想到if语句。然后我制作一张简单的样表，A2设置为输入序号，B2里放日期和时间，当A2输入内容后，B2自动输入当前日期和时间。那么B2列里设置函数=IF(A2="","",NOW()) 开始以为就这么简单，但是发现这个表格如果重新打开后，所以B列都会变为最新的日期，而且当A2被重新编辑后，B2就会变更日期为最新日期，这样完全实现不了采购同事的需求。于是我查阅了资料，找到了Target更新事件和Offset获得焦点，让他们配合起来达到目的，经过不懈的努力，终于让我把代码写成功了，初步达到了采购同事的要求。特此把代码写在下面。供大家参考（以下代码最好配合实际案例的execl表的环境进行阅读，这样事半功倍，execl表，我把它挂载到一个下载链接吧）： Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 1 And Target.Column <> 5 Or Target.Count > 1 Then Exit Sub On Error Resume Next With Target If .Column = 1 And .Offset(0, 1).Value = "" Then '判断该单元格是否已经写入时间 .Offset(0, 1) = Now() End If If .Column = 5 Then '计算合计价格 .Offset(0, 1) = .Offset(0, 0) * .Offset(0, -1) End If End With End Sub