1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
| Function tqzf(STR As String, str1 As String, i As Integer) tqzf = Split(STR, str1)(i - 1) End Function
Function SFZSR(STR) SFZSR = Format(DateSerial(Mid(STR, 7, 4), Mid(STR, 11, 2), Mid(STR, 13, 2)), "yyyy/m/d") End Function
Function YuanCapital(Amountin) YuanCapital = Replace(Application.Text(Round(Amountin + 0.00000001, 2), "[DBnum2]"), ".", "元") YuanCapital = IIf(Left(Right(YuanCapital, 3), 1) = "元", Left(YuanCapital, Len(YuanCapital) - 1) & "角" & Right(YuanCapital, 1) & "分", IIf(Left(Right(YuanCapital, 2), 1) = "元", YuanCapital & "角", IIf(YuanCapital = "零", "", YuanCapital & "元整"))) YuanCapital = Replace(Replace(Replace(Replace(YuanCapital, "零元零角", ""), "零元", ""), "零角", "零"), "-", "负") End Function
Public Function IsBlankSht(Sh As Variant) As Boolean If TypeName(Sh) = "String" Then Set Sh = Worksheets(Sh) If Application.CountA(Sh.UsedRange.Cells) = 0 Then IsBlankSht = True End If End Function
Function EXTNUM(STR As String) Set regx = CreateObject("vbscript.regexp") With regx .Global = True .Pattern = "\D" EXTNUM = .Replace(STR, "") End With End Function
Function EXTHZ(STR As String) Set regx = CreateObject("vbscript.regexp") With regx .Global = True .Pattern = "\w" EXTHZ = .Replace(STR, "") End With End Function
Function EXTEN(STR As String) Set regx = CreateObject("vbscript.regexp") With regx .Global = True .Pattern = "[^a-zA-Z]" EXTEN = .Replace(STR, "") End With End Function
Function MONEYSUM(STR As String) Dim i As Integer, j As Double, m As Variant Set regx = CreateObject("vbscript.regexp") With regx .Global = True .Pattern = "\d+\.?\d?(?=[元块])" Set mat = .Execute(STR) End With For Each m In mat j = j + m * 1 Next MONEYSUM = j End Function
Function SFZDZ(rng As Range) Dim dic As Object Dim conn As Object, i As Integer Dim arr() Set conn = CreateObject("adodb.connection") Set dic = CreateObject("Scripting.Dictionary") conn.Open "Provider = Microsoft.ACE.OLEDB.12.0;Data Source=F:\Excel\ADO固定数据库\身份证号前6位对应归属地.xlsx;extended properties=""excel 12.0;HDR=YES""" arr = Application.WorksheetFunction.Transpose(conn.Execute("select * from [Sheet1$]").GetRows) For i = 1 To UBound(arr) dic.Add arr(i, 1), arr(i, 2) Next K = Left(rng, 6) SFZDZ = dic(K * 1) conn.Close End Function
Function SFZNN(str2 As String) Dim STR As String, str1 As String STR = VBA.Mid(str2, 7, 8) str1 = VBA.DateSerial(Left(STR, 4), Mid(STR, 5, 2), Right(STR, 2)) SFZNN = VBA.Int(DateDiff("d", str1, Date) / 365) End Function
Function SFZXB(rng As Range) Dim i As Integer i = VBA.Mid(rng, 17, 1) * 1 SFZXB = VBA.IIf(i Mod 2, "男", "女") End Function
Function SFZSX(rng As Range) Dim arr() Dim i As Integer i = Year(VBA.Format(rng, "yyyy/m/d")) Mod 12 arr = Array("鸡", "狗", "猪", "鼠", "牛", "虎", "兔", "龙", "蛇", "马", "羊", "猴") If i = 0 Then SFZSX = arr(11) Else: SFZSX = arr(i - 1) End If End Function
Function SFZXZ(rng As Range) Dim arr(), arr1(), arr2() Dim i As Double i = Format(rng, "m.dd") arr = [{0,"魔羯座";1.2,"水瓶座";2.19,"双鱼座";3.21,"白羊座";4.2,"金牛座";5.21,"双子座";6.22,"巨蟹座";7.23,"狮子座";8.23,"处女座";9.23,"天秤座";10.24,"天蝎座";11.23,"射手座";12.22,"魔羯座"}] arr1 = Application.WorksheetFunction.Index(arr, 0, 1) arr2 = Application.WorksheetFunction.Index(arr, 0, 2) SFZXZ = Application.WorksheetFunction.Lookup(i, arr1, arr2) End Function
|