宏相关-动态数组、正则等问题
2021-02-02 04:16
标签：temp 效率比较 没有想到 效率 hid 行号 运行 简单 思想 整理下最近碰到的vba问题及我笨拙的解决方式。学的方式为遇到问题想办法去解决，查资料，补充知识点，可能代码有点拙劣，前期也没追求优化，简洁。以实现结果为目标。遇到很多用宏解决比较繁琐的问题比如批量合并几十个大容量CSV文件，会转换思想写个python脚本去解决。宏合并的方式就不写了，确实不如python高效。 1.获取文件夹路径方式（当然方式不止此一种） 2.比较2表中2列数据，筛选出2列中相同项和不同项------astrResultsSame中存放相同项，astrResultsDis存放不同项 3.获取筛选条件行标题下第一个符合条件的可见行的行号（row）-----筛选发生在第7行，获取第7行下第一个可见单元格行。此方式可类推到下任意可见单元行 4.正则的简单运用---批量选择每行文字中的银行账号。简单选择出来，需要剔除的条件其实很多，正则没写的那么复杂。 5.for..each/if语句设计复杂的公式及在菜单栏定义自定义宏运行按钮 (：自认为很臭很长，但没有想到好的方式，直观的想简单一些，就这么搞去了) 菜单栏生成自定义按钮： 6. 动态数组运用，注意动态数据ReDim Preserve brr(1 To 14, 1 To k) 仅可以动态变化列维度，设置行维度可变会报错。写了2种方式效率比较。数组法优于操作单元格的方式 宏相关-动态数组、正则等问题 标签：temp 效率比较 没有想到 效率 hid 行号 运行 简单 思想 原文地址：https://www.cnblogs.com/hqczsh/p/12811482.html strPath = ThisWorkbook.Path & Application.PathSeparator
strFile = strPath & "数据源\xx.xlsx"
Set wrbk = Workbooks.Open(strFile)
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
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
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
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.045 Then
.Range("AR" & Cel.Row) = 0
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 = 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 = 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 = 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 = 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 = 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
‘ 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