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

Mr.Right

不顾一切的去想,于是我们有了梦想。脚踏实地的去做,于是梦想成了现实。

 
 
 

日志

 
 
关于我

人生一年又一年,只要每年都有所积累,有所成长,都有那么一次自己认为满意的花开时刻就好。即使一时不顺,也要敞开胸怀。生命的荣枯并不是简单的重复,一时的得失不是成败的尺度。花开不是荣耀,而是一个美丽的结束,花谢也不是耻辱,而是一个低调的开始。

网易考拉推荐

EXCEL VBA Dictionary Select实现分类  

2016-03-06 19:26:35|  分类: 编程 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
Sub 宏1()

Set dic = CreateObject("Scripting.Dictionary") '字典
Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
Set dic3 = CreateObject("Scripting.Dictionary")
Set dic4 = CreateObject("Scripting.Dictionary")
For i = 1 To 100
    If Not i Like "*4*" Then '如果i不包含“4”
        dic.Add i, ""
    End If
    
    If i Like "*1*" Then
        dic1.Add i, "F" & i & "_"
        dic4.Add dic4.Count + 1, "F" & i & "_"
    End If
    
    If i Like "*2*" Then
        dic2.Add i, "F" & i & "_"
        dic4.Add dic4.Count + 1, "F" & i & "_"
    End If
    
    If i Like "*3*" Then
        dic3.Add i, "F" & i & "_"
        dic4.Add dic4.Count + 1, "F" & i & "_"
    End If
    
Next


dic1.Add "A", "F1" & "_"
dic2.Add "A", "F2" & "_"
dic3.Add "A", "F3" & "_"
dic4.Add "A", "F1" & "_"
dic4.Add "B", "F2" & "_"
dic4.Add "C", "F3" & "_"

Range("a2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys) '从A2单元开始向下放置

Range("c2").Resize(dic1.Count, 1) = Application.WorksheetFunction.Transpose(dic1.keys)
Range("d2").Resize(dic1.Count, 1) = Application.WorksheetFunction.Transpose(dic1.Items)

Range("e2").Resize(dic2.Count, 1) = Application.WorksheetFunction.Transpose(dic2.keys)
Range("f2").Resize(dic2.Count, 1) = Application.WorksheetFunction.Transpose(dic2.Items)

Range("g2").Resize(dic3.Count, 1) = Application.WorksheetFunction.Transpose(dic3.keys)
Range("h2").Resize(dic3.Count, 1) = Application.WorksheetFunction.Transpose(dic3.Items)

Range("j2").Resize(dic4.Count, 1) = Application.WorksheetFunction.Transpose(dic4.keys)
Range("k2").Resize(dic4.Count, 1) = Application.WorksheetFunction.Transpose(dic4.Items)


' 对dic进行遍历
n = dic.Count
Debug.Print "dic count =" & n
k = dic.keys
v = dic.Items
For i = 0 To dic.Count - 1
    Key = k(i)
    Value = v(i)
    Debug.Print Key & Value
Next


' 对dic4进行遍历


n = dic4.Count
Debug.Print "dic4 count =" & n
v = dic4.Items
For i = 0 To dic4.Count - 1
    strTemp = RegEx(CStr(v(i)))
    Select Case strTemp   ' 注意 select case中条件仅能是 整数 或 字符串
        Case "F1_"
            Debug.Print "F1 ->" & strTemp
        Case "F2_"
            Debug.Print "F2 ->" & strTemp
        Case "F3_"
            Debug.Print "F3 ->" & strTemp
'        Case Else
'        Debug.Print "not valid"
    End Select

Next



End Sub

Private Sub TestReg()
    MsgBox RegEx("F11_ F1_")
End Sub

Private Function RegEx(s As String) As String
    Dim re, match
    Set re = CreateObject("vbscript.regexp")
    re.Pattern = "(F\d\D)"
    re.Global = True

    For Each match In re.Execute(s)
        'MsgBox match.Value
        RegEx = match.Value
        Exit For  ' uncomment to get the first match
    Next
    Set re = Nothing
End Function

Sub 时间()
Dim Tim As Byte, msg As String
Tim = Hour(Now)
Select Case Tim  ' 注意 select case中条件仅能是 整数 或 字符串
Case 1 To 11
msg = "上午"
Case 12
msg = "中午"
Case 13 To 16
msg = "下午"
Case 17 To 20
msg = "晚上"
Case 23, 24
msg = "午夜"
End Select
MsgBox "现在是:" & msg
End Sub

  评论这张
 
阅读(179)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

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

页脚

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