VBA 常用知识点

VBA对象传参

  1. 首先主函数中必须定义参数的类型
  2. 函数调用语法为 函数名 参数1 参数2
  3. 被调用函数中定义传参是否引用(byref)还是重新建立一份数据(byval)
    代码示例
Sub auto_count()
Dim wb_obj As Workbook
Dim wsh_obj As Worksheet
filepth = get_file_pth()
Set wb_obj = GetObject(filepth)
Set wsh_obj = wb_obj.Worksheets("工作博1")
total_check wsh_obj  '对象传参看这步
'GetObject 默认保存后文件内容不可见,要设置可视为真才能正常浏览
Application.Windows(wb_obj.Name).Visible = True
' 文件保存设置为真
wb_obj.Close True
End Sub

Sub total_check(ByRef wst As Worksheet)
'表中E列总金额和F-I列的4个季度收费金额总和做比对
'
With wst
max_row = .Range("a:a").Rows.Count
last_row = .Range("a" & max_row).End(xlUp).Row
For i = 6 To last_row
    total_money = .Range("e" & i).Value
    first_quarter = .Range("f" & i).Value
    second_quarter = .Range("g" & i).Value
    three_quarter = .Range("h" & i).Value
    four_quarter = .Range("i" & i).Value
    '判断第一到第四季度和E列总金额是否相等,不相等,E列单元格底色变红色
    If total_money <> (first_quarter + second_quarter + three_quarter + four_quarter) Then
    .Range("E" & i).Interior.ColorIndex = 6
    .Range("E" & i).ClearComments
    .Range("E" & i).AddComment ("金额有误")
    Else
    .Range("E" & i).Interior.ColorIndex = 0
    .Range("E" & i).ClearComments
    End If
    
    If .Range("k" & i).Value > 0 Then
        a = .Range("k" & i)
        rate_set .Range("k" & i)
    End If

Next

End With
End Sub

单元格背景色对应的索引值

Range("E" & i).Interior.ColorIndex = 6

vba删除多个不连续的行

Dim deleteRange As Range

' 要删除的行号
Dim row1 As Long
row1 = 5

Dim row2 As Long
row2 = 10

' 合并要删除的行范围
If deleteRange Is Nothing Then
    Set deleteRange = Rows(row1)
Else
    Set deleteRange = Union(deleteRange, Rows(row1))
End If

Set deleteRange = Union(deleteRange, Rows(row2))

' 删除范围中的行
If Not deleteRange Is Nothing Then
    deleteRange.Delete Shift:=xlUp
End If

拆分合并单元格并填充数据

以前填充数据的逻辑是获取合并的面积后然后用cell.resize再往里填写数据

For i = 2 To .Range("B65536").End(xlUp).Row
 StrMer = .Cells(i, 2).Value
 IntCot = .Cells(i, 2).MergeArea.Count
 .Cells(i, 2).UnMerge
 .Range(.Cells(i, 2), .Cells(i + IntCot - 1, 2)).Value = StrMer
 i = i + IntCot - 1
Next

'或者是这样的
    For Each cell In rng
        If cell.MergeCells Then ' 检查单元格是否为合并单元格
            mergeData = cell.MergeArea.Value ' 获取合并单元格的数据
            cell.MergeArea.UnMerge ' 取消合并单元格
            ' 拆分合并数据到拆分的单元格中
            Set splitRange = cell.Resize(UBound(mergeData, 1), UBound(mergeData, 2))
            splitRange.Value = mergeData
        End If
    Next cell

还有效率更高的写法,分析如下

Sub UnMergeFill()

Dim cell As Range, joinedCells As Range
For Each cell In ThisWorkbook.ActiveSheet.UsedRange
    If cell.MergeCells Then
        Set joinedCells = cell.MergeArea
        cell.MergeCells = False
        '就是这一步 我们可以看到joinedCells 就是获取了合并单元格的MergeArea属性,此时他也是个单元格对象,
        '意味着同时也是多个cells的集合体,可以直接设置他的value为某个值,那么整个range对象里的cell都会填充这个值
        joinedCells.Value = cell.Value
    End If
Next

End Sub

我们可以自行再测试一下,将一个单元格range("a1:b5") 都填充aa
我们可以遍历循环每个cell的value为aa,也可以利用上面的原理,set b =range("a1:b5")
然后设置b.value = "aa" 也可以实现填充
同时在这个对象中还可以通过rows.count columns.count获取单元格对象一共是几行几列.
这个在上面的合并单元格中也适用.上面的joinedCells也可以用joinedCells.rows.count joinedCells.columns.count判断合并单元格的范围是多大

当这个Rng对象部分是合并单元格 如果是合并单元格 需要跳过合并的行数 继续遍历后续的对象,可以这样实现

Dim Rng As Range
Set Rng = Range("C2832:C2845")

Dim cell As Range
For Each cell In Rng
    If cell.MergeCells Then ' 检查是否为合并单元格
        Dim mergeRange As Range
        Set mergeRange = cell.MergeArea ' 获取合并单元格的范围
        Dim skipRows As Long
        skipRows = mergeRange.Rows.Count - 1 ' 获取合并单元格的行数
        ' 跳过合并单元格的行数
        Set cell = cell.Offset(skipRows)
    End If
    ' 处理每个单元格
    Debug.Print cell.Value ' 以示例输出单元格的值
Next cell
posted @ 2023-01-18 17:28  零哭谷  阅读(100)  评论(0编辑  收藏  举报