宏相关-动态数组、正则等问题

整理下最近碰到的vba问题及我笨拙的解决方式。学的方式为遇到问题想办法去解决，查资料，补充知识点，可能代码有点拙劣，前期也没追求优化，简洁。以实现结果为目标。遇到很多用宏解决比较繁琐的问题比如批量合并几十个大容量CSV文件，会转换思想写个python脚本去解决。宏合并的方式就不写了，确实不如python高效。

1.获取文件夹路径方式（当然方式不止此一种）

    strPath = ThisWorkbook.Path & Application.PathSeparator
    strFile = strPath & "数据源xx.xlsx"
    Set wrbk = Workbooks.Open(strFile)

　　

2.比较2表中2列数据，筛选出2列中相同项和不同项------astrResultsSame中存放相同项，astrResultsDis存放不同项

    arr1() = WorksheetFunction.Transpose(wrbk.Worksheets(1).Range("b8:b" & [b1048576].End(xlUp).Row).Value)
    arr2() = WorksheetFunction.Transpose(wrbk.Worksheets(1).Range("a" & a & ":" & "a" & c).Value)  '人员集
    
    For intTemp = 1 To UBound(arr1())
        avntTemp = Filter(arr2(), arr1(intTemp), True)
        If UBound(avntTemp) >= 0 Then
            intCountSame = intCountSame + 1
            ReDim Preserve astrResultsSame(1 To intCountSame)
            astrResultsSame(intCountSame) = arr1(intTemp)
        Else
            intCountDis = intCountDis + 1
            ReDim Preserve astrResultsDis(1 To intCountDis)
            astrResultsDis(intCountDis) = arr1(intTemp)
        End If
    Next intTemp

　　

3.获取筛选条件行标题下第一个符合条件的可见行的行号（row）-----筛选发生在第7行，获取第7行下第一个可见单元格行。此方式可类推到下任意可见单元行

    i = 7
    Const n = 1
    Do
        i = i + 1
        If wrbk.Worksheets(1).Cells(i, 1).EntireRow.Hidden = False Then  '获取第二行可见的单元格  第8行可见的话执行以下语句
            k = k + 1
        End If
    Loop Until k = n
    Debug.Print i, RngCnt, c

　　

4.正则的简单运用---批量选择每行文字中的银行账号。简单选择出来，需要剔除的条件其实很多，正则没写的那么复杂。

    With regx
      .Global = True
        For Each cel In Range("v2:v9487")
            .Pattern = "d{16,26}"
            Set tx = .Execute(cel)
            For Each m In tx
               Cells(cel.Row, 27) = m
            Next m
        Next
    End With

5.for..each/if语句设计复杂的公式及在菜单栏定义自定义宏运行按钮 (：自认为很臭很长，但没有想到好的方式，直观的想简单一些，就这么搞去了)

Sub 生成金额()

    Dim arr
    Dim a%, b
    Dim Cel As Range
    Dim sh As Worksheet
    
    Set sh = ThisWorkbook.Sheets(数据源")
    a = sh.[A65535].End(xlUp).Row    '行数
    b = ThisWorkbook.Worksheets("生成金额按钮").Range("b1").Value
    Debug.Print b
    Debug.Print b > 0.8
    With sh
        If b < 0.8 Then
            For Each Cel In .Range("AP2:AP" & a)
                If .Range("AS" & Cel.Row) = "xxx1" Or .Range("AS" & Cel.Row) = "xxx2" Then
                    If .Range("AT" & Cel.Row) > 0.045 Then
                        .Range("AR" & Cel.Row) = 0
                    ElseIf Cel.Value < 300 Then
                        .Range("AR" & Cel.Row) = .Range("W" & Cel.Row) * 0.25
                    ElseIf Cel.Value < 600 Then
                         .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 0.5 - 75) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value < 1000 Then
                         .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 0.75 - 225) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value < 1500 Then
                         .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 1 - 475) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value >= 1500 Then
                         .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 1.5 - 1225) / .Range("AQ" & Cel.Row)
                    End If
                ElseIf .Range("AS" & Cel.Row) = "xxx3" Then
                    If .Range("AT" & Cel.Row) > 0.018 Then
                        .Range("AR" & Cel.Row) = 0
                    ElseIf Cel.Value < 300 Then
                        .Range("AR" & Cel.Row) = .Range("W" & Cel.Row) * 0.25
                    ElseIf Cel.Value < 600 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 0.5 - 75) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value < 1000 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 0.75 - 225) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value < 1500 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 1 - 475) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value >= 1500 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 1.5 - 1225) / .Range("AQ" & Cel.Row)
                    End If
                Else
                    If .Range("AT" & Cel.Row) > 0.01 Then
                        .Range("AR" & Cel.Row) = 0
                    ElseIf Cel.Value < 300 Then
                        .Range("AR" & Cel.Row) = .Range("W" & Cel.Row) * 0.25
                    ElseIf Cel.Value < 600 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 0.5 - 75) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value < 1000 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 0.75 - 225) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value < 1500 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 1 - 475) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value >= 1500 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 1.5 - 1225) / .Range("AQ" & Cel.Row)
                    End If
                End If
            Next Cel
        Else
            For Each Cel In .Range("AP2:AP" & a)
                If .Range("AS" & Cel.Row) = "xxx1" Or .Range("AS" & Cel.Row) = "xxx2" Then
                    If .Range("AT" & Cel.Row) > 0.045 Then
                        .Range("AR" & Cel.Row) = 0
                    ElseIf Cel.Value < 300 Then
                        .Range("AR" & Cel.Row) = .Range("W" & Cel.Row) * 0.5
                    ElseIf Cel.Value < 600 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 1 - 150) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value < 1000 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 1.5 - 450) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value < 1500 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 2 - 950) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value >= 1500 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 3 - 2450) / .Range("AQ" & Cel.Row)
                    End If
                ElseIf .Range("AS" & Cel.Row) = "xxx3" Then
                    If .Range("AT" & Cel.Row) > 0.018 Then
                        .Range("AR" & Cel.Row) = 0
                    ElseIf Cel.Value < 300 Then
                        .Range("AR" & Cel.Row) = .Range("W" & Cel.Row) * 0.5
                    ElseIf Cel.Value < 600 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 1 - 150) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value < 1000 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 1.5 - 450) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value < 1500 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 2 - 950) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value >= 1500 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 3 - 2450) / .Range("AQ" & Cel.Row)
                    End If
                Else
                    If .Range("AT" & Cel.Row) > 0.01 Then
                        .Range("AR" & Cel.Row) = 0
                    ElseIf Cel.Value < 300 Then
                        .Range("AR" & Cel.Row) = .Range("W" & Cel.Row) * 0.5
                    ElseIf Cel.Value < 600 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 1 - 150) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value < 1000 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 1.5 - 450) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value < 1500 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 2 - 950) / .Range("AQ" & Cel.Row)
                    ElseIf Cel.Value >= 1500 Then
                        .Range("AR" & Cel.Row) = (.Range("AP" & Cel.Row) * 3 - 2450) / .Range("AQ" & Cel.Row)
                    End If
                End If
            Next Cel
        End If
    End With
End Sub

　　

菜单栏生成自定义按钮：

6. 动态数组运用，注意动态数据ReDim Preserve brr(1 To 14, 1 To k) 仅可以动态变化列维度，设置行维度可变会报错。写了2种方式效率比较。数组法优于操作单元格的方式

' the first one
Sub 筛选达标率()

    t1 = Timer
    Dim Cel As Range
    Dim a%, b%, c%, sumx%, sumy%
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        For Each Cel In .Range("I1:I20")
            If Cel = .Range("j20") Then
                a = Cel.Row
            ElseIf Cel = .Range("k20") Then
                b = Cel.Row
            End If
        Next Cel
        .Range("I23:V34").Clear
        .Range("i" & a & ":" & "V" & b).Copy
        With .Range("i23")
            .PasteSpecial , Operation:=xlNone, SkipBlanks:=False
            .Font.Name = "微软雅黑"
            .Font.Size = 9
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        For Each Cel In .Range("j" & a & ":" & "j" & b)
            sumx = sumx + Cel.Value
        Next Cel
        For Each Cel In .Range(Cells(2, 9), Cells(2, 22))
            If Cel = .Range("l20") Then
                c = Cel.Column
            End If
        Next Cel
        For Each Cel In .Range(Cells(a, c), Cells(b, c))
            sumy = sumy + Cel.Value
        Next Cel
        
        .Range("M20") = Str(Round(100 * sumy / sumx, 2)) & "%"
    End With
    Application.ScreenUpdating = True
    t2 = Timer
    Debug.Print "操作单元格耗时" & (t2 - t1)

End Sub

' the second one
Sub 数组法()

    t1 = Timer
    Application.ScreenUpdating = False
    Dim arr(), brr()
    Dim i%, j%, a%, b%, s1%, s2%
    
    arr = Range("i2:v14").Value
    
    With ActiveSheet
        For i = 2 To UBound(arr, 1)
            If arr(i, 1) = .Range("j20") Then  'i 为在数组中的位置
                a = i
            ElseIf arr(i, 1) = .Range("k20") Then
                b = i
            End If
        Next i
        For i = 1 To UBound(arr, 2)
            If arr(1, i) = .Range("l20") Then
                j = i
            End If
        Next i
        For i = a To b
            s1 = s1 + arr(i, j)
            s2 = s2 + arr(i, 2)
        Next i
        .Range("m20") = Str(Round(100 * s1 / s2, 2)) & "%"
        k = 1
        For i = a To b
            For j = 1 To UBound(arr, 2)
                ReDim Preserve brr(1 To 14, 1 To k)
                brr(j, k) = arr(i, j)
            Next j
            k = k + 1
        Next i
        .Range("I23:V34").Clear
        .Range("i23").Resize(UBound(brr, 2), UBound(brr, 1)) = WorksheetFunction.Transpose(brr)
       Erase brr
    End With
    With ActiveSheet.Range("i23:v34")
        .Font.Name = "微软雅黑"
        .Font.Size = 9
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    Application.ScreenUpdating = True
    
    t2 = Timer
    Debug.Print "数组耗时" & (t2 - t1)
    
End Sub