记录学习VBA过程的点点滴滴(每天进步一点点)

jiminyanyan

开个帖,记录一些学习VBA过程的点点滴滴。。

jiminyanyan

一个提取数字的题。用正则表达式做的。

1. Sub Reg()
   
2.     Dim oReg As Object
   
3.     Dim oMatches As Object
   
4.     Dim oMatch As Object
   
5.     Dim i As Integer
   
6.     Dim dSum As Double
   
7.     Set oReg = CreateObject("vbscript.regexp")
   
8.     With oReg
   
9.         .Global = True
   
10.         '设置模式匹配数字（含小数）
    
11.         .Pattern = "\d+\.?\d+|\d+"
    
12.         For i = 2 To Range("a65535").End(xlUp).Row
    
13.             '先判断是否匹配成功，成功则继续
    
14.             If .test(Cells(i, 1)) Then
    
15.                 '获得匹配结果的集合
    
16.                 Set oMatches = .Execute(Cells(i, 1))
    
17.                     '加匹配结果加和
    
18.                     m = 2
    
19.                     For Each oMatch In oMatches
    
20.                         Cells(i, m) = oMatch
    
21.                         m = m + 1
    
22.                     Next
    
23.                     m = 2
    
24.                
    
25.             End If
    
26.         Next
    
27.     End With
    
28. End Sub
    
29. 
    

复制代码

这个题本身不重要，重要的是它给我引出了正则表达式，正则表达式还是比较强大的。做这题 我仅知道有正则表达式这样一个东西，
'设置模式匹配数字（含小数）
.Pattern = "\d+\.?\d+|\d+"
这个表达式，做题那会还看不懂，网上搜来的。
能给大家带来启发的是，即使对有的知识点陌生，学会搜索，照猫画虎还是能解决一些问题的。

lzqmsy

学习一下,最好来个excel附件

jiminyanyan

有不少人求助，当别人给出回复时，能解决问题就放在一边不管了。其实应多关注一下答案之外的东西。
记得有一次，有人给我的回复帖里有Set d = CreateObject("scripting.dictionary")这样的对我挺陌生的语句，一问才知这是字典，另外老师还推荐了蓝老师的比较经典的帖子。
如这个知识点自己以前是知道的，应学会举一反三，触类旁通，将别人的代码化为己用。

jiminyanyan

几个取单元格中文、字母、数字的自定义函数。。。
Function GetText(str As String)
   Dim RegEx As Object
   Set RegEx = CreateObject("vbscript.regexp") '调用正则表达式
   With RegEx
   .Global = True
   .Pattern = "[!-~]"
   End With
   GetText = RegEx.Replace(str, "")
End Function
Function GetNoText(str As String)
   Dim RegEx As Object
   Set RegEx = CreateObject("vbscript.regexp") '调用正则表达式
   With RegEx
   .Global = True
   .Pattern = "[^A-Za-z0-9]"
   End With
   GetNoText = RegEx.Replace(str, "")
End Function

Function 取字母(str As String)
   Dim RegEx As Object
   Set RegEx = CreateObject("vbscript.regexp") '调用正则表达式
   With RegEx
   .Global = True
   .Pattern = "[^A-Za-z]"
   End With
  取字母 = RegEx.Replace(str, "")
End Function
Function 取数字(str As String)
   Dim RegEx As Object
   Set RegEx = CreateObject("vbscript.regexp") '调用正则表达式
   With RegEx
   .Global = True
   .Pattern = "[^0-9]"
   End With
  取数字 = RegEx.Replace(str, "")
End Function

fxg2007

这个挺好的，谢谢

jiminyanyan

获取首行最后一个非空列的列标
Sub test()
    MsgBox WorksheetFunction.Substitute(Cells(1, Columns.Count).End(xlToLeft).Address(0, 0), 1, "") 'G
    MsgBox Cells(1, Columns.Count).End(xlToLeft).Column '7
End Sub

jiminyanyan

Q:在excel的一个固定单元格每次输入不同数字或汉子， 在另外一列中按顺序自动保存每次输入的内容，应该就是汇总每次输入的内容
A:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target <> [a1] Then Exit Sub
    Target.Offset(0, 1) = Target.Offset(0, 1) & Target.Value & "|"
End Sub

AVEL

jiminyanyan 发表于 2011-8-20 23:50
一个提取数字的题。用正则表达式做的。
这个题本身不重要，重要的是它给我引出了正则表达式，正则表达式 ...

1. Sub Reg()
   
2.     Dim oReg As Object
   
3.     Dim oMatches As Object
   
4.     Dim oMatch As Object
   
5.     Dim i As Integer
   
6.     Dim dSum As Double
   
7.     Set oReg = CreateObject("vbscript.regexp")
   
8.     With oReg
   
9.         .Global = True
   
10.         .Pattern = "[^\d，.]"
    
11.         For i = 2 To Range("a65535").End(xlUp).Row
    
12.             If .test(Cells(i, 1)) Then
    
13.                 a = Split(.Replace(Cells(i, 1), ""), "，")
    
14.                Cells(i, 2).Resize(, UBound(a)).Value = a
    
15.             End If
    
16.         Next
    
17.     End With
    
18. End Sub

复制代码

还可以改写。
我是在学习正则的时候看到你的帖子的。呵呵。

jiminyanyan

http://club.excelhome.net/thread-752409-1-2.html
这段收集备用。。。
Sub Macro1()
    Dim d(1 To 2) As Object, arr(1 To 2), i&, l&, t
    For l = 1 To 2
        Set d(l) = CreateObject("scripting.dictionary")
        arr(l) = Sheets(l).[a1].CurrentRegion
        For i = 2 To UBound(arr(l))
            If arr(l)(i, 1) = 1 Then d(l)(arr(l)(i, 2)) = i
        Next
    Next
    For i = 2 To UBound(arr(1))
        If arr(1)(i, 1) = 1 Then
            If d(1).Exists(arr(1)(i, 2)) And d(2).Exists(arr(1)(i, 2)) Then
                d(1).Remove (arr(1)(i, 2))
                d(2).Remove (arr(1)(i, 2))
            End If
        End If
    Next
    For l = 1 To 2
        With Sheets(l)
            .[b:b].Interior.ColorIndex = xlNone
            t = d(l).Items
            For i = 0 To UBound(t)
                .Cells(t(i), 2).Interior.ColorIndex = 3
            Next
        End With
    Next
End Sub