注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

零售创新,创新那些事儿,SPSS,VBA

零售创新

 
 
 

日志

 
 
关于我

新浪微博,零售创新 研究经理,数据分析师 希望和市场研究和零售业的同事共同进步! 本博客发表的都是免费或试用的资料,如果有版权问题请发邮件wangli12a@163.com联系删除。 spss excel vba blog

网易考拉推荐

VBA 查找 数字宏  

2013-06-08 18:33:40|  分类: VB和VBA知识 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
Function FromatTel(Tel As String, Optional Format As Integer = 0, Optional NewSeparator As String = "-") As String
     '返回电话号码的各种格式
     '可单元格中直接调用,可函数或过程调用
     '2010.11.05
     'www.okexcel.com.cn
     'Ver 1.0.0
     '参数说明: Tel:带区号的电话号码,可以是各种常见格式,如010-12345678,8601012345678
     '           Format:设置返回格式,0(默认值)为只返回区号,1为只返回电话号,2为返回加分隔符的区号+电话号如(010)12345678,010-12345678,010_12345678
     '           NewSeparator:新分隔符,可以是"()","-","_"或是""等等格式,只有在Format为2时有效
     '返回值:日期
     Dim Matches As Object
     Dim ns1 As String, ns2 As String
     Set Matches = ExExce(Tel, "\s*0(([1,2]\d)|([3-9]\d{2}))(?=(\D*[2-8]\d{6,7})\b)|([2-8]\d{6,7})\b", True)
     If Matches.Count <> 2 Then
          If TypeName(Application.Caller) = "Range" Then FromatTel = CVErr(xlErrValue)
         Exit Function
     End If
     Select Case Format
         Case 1:
             FromatTel = Matches(1).Value
         Case 2:
             NewSeparator = Right("  " & NewSeparator, 2)
             ns1 = Trim(Left(NewSeparator, 1)): ns2 = Trim(Right(NewSeparator, 1))
             FromatTel = ns1 & Matches(0).Value & ns2 & Matches(1).Value
         Case Else
             FromatTel = Matches(0).Value
     End Select
End Function

Function ExExce(sStr As String, sPatrn As String, Optional IC As Boolean = True, Optional G As Boolean = True) As Object

'参数说明:sStr原字符串,Patrn样式,IC是否区别大小写,G是否全局可用
     '返回参数,返回的是一个对象,ExExce.Count是搜索的数量
     '                            ExExce(n).FirstIndex搜索的第n个串的位置,n>=0
     '                            ExExce(n).Value搜索的第n个串的值,n>=0
     Dim regex As Object
     Set regex = CreateObject("VBSCRIPT.REGEXP") 'RegEx为建立正则表达式
     regex.Global = True                         '设置全局可用
     regex.Pattern = sPatrn                      '设置样式
     regex.IgnoreCase = IC                       '设置是否区分大小写。
     Set ExExce = regex.Execute(sStr)            '执行搜索
     Set regex = Nothing
 End Function

'((\d{11})|^((\d{7,8})|(\d{4}|\d{3})-(\d{7,8})|(\d{4}|\d{3})-(\d{7,8})-(\d{4}|\d{3}|\d{2}|\d{1})|(\d{7,8d})-(\d{4}|\d{3}|\d{2}|\{1}))$)

Function 汉字(reg, Optional gb As Boolean = True) As String
             '功能:提取给定字符串(单元格)中汉字与非汉字集  说明:reg  原字符串或单元格   gb   当为True时,提取汉字(默认),否则提取非汉字。
             '可以同时使用自定义函数形式提取亦可以使用VBA批量提取 公式:=Fonts(A1) 或公式:=Fonts(A1,1) 仅提取A1里的汉字 公式:=Fonts(A1,0) 仅提取A1单元格的非汉字
With CreateObject("VBSCRIPT.REGEXP")
    .Global = True
    If gb Then
        .Pattern = "[^\u4e00-\u9fa5]"
    Else
        .Pattern = "[\u4e00-\u9fa5]"
    End If
    汉字 = .Replace(reg, "")
End With
End Function

Sub num()

Dim i As Integer, m, m1, m2, s, s1 As Integer, str, str1, str2 As String


m = Worksheets(1).UsedRange.Rows.Count

For i = 2 To m

str = Cells(i, 1).Value

t1 = Len(str)

s1 = 1
For k = 1 To t1

 If Mid(str, k, 1) = "(" Or Mid(str, k, 1) = "(" Then
 s = k
 End If
 Next
 
 
m1 = s + 1
For j = m1 To Len(str)




str2 = Mid(str, j, 1)

If str2 Like "[0-9]" Then
s2 = j
Else
s1 = j

End If
'End If

Next
s3 = t1 - s2
str1 = Mid(str, s + 1, t1 - m1 - s3)

Cells(i, 2) = str1


Next

End Sub

Sub add()
Dim i As Integer, m, m1, m2 As Integer, str, str1 As String

For i = 1 To 12
m = Len(Cells(i, 1).Value)
m1 = Len(Cells(i, 5).Value)



Cells(i, 4) = Left(Cells(i, 1), m - m1)



Next

End Sub
  评论这张
 
阅读(753)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017