我有一个宏,它检查过滤列结果的每个单元格。它检查 14 个不同的范围。我想知道,是否有可能以某种方式剪切我的代码,这样我就不必将相同的指令复制/粘贴到不同的范围?我正在考虑使用字典,但我不确定这是一个好的解决方案,而且不知道如何混合检查不同的范围并将结果插入不同的位置。下面我给你一个代码:
Sub check_training()
Dim MyRange As Range
Dim rng1 As Range
Dim MyCell As Variant
Dim strAddress As String
Set MyRange = Range([a1], [a1].End(xlDown)).Rows.SpecialCells(xlCellTypeVisible)
'PP 2dni 2007
For Each MyCell In MyRange.Cells
With Range("pp2dni2007")
Set rng1 = .Cells.Find(MyCell.Value)
If Not rng1 Is Nothing Then
If Not IsEmpty(MyCell.Offset(0, liczba).Value) Then
Else
strAddress = rng1.Address
Do
If .Cells.Find(MyCell.Value).Offset(0, 3).Value = "TAK" Then
MyCell.Offset(0, liczba).Value = MyCell.Offset(0, liczba).Value + 1
Else
MyCell.Offset(0, liczba).Value = 0
End If
Set rng1 = .Cells.FindNext(rng1)
Loop While rng1.Address <> strAddress
End If
End If
End With
Next
'PP 3dni 2008
liczba = liczba + 1
For Each MyCell In MyRange.Cells
With Range("pp3dni2008")
Set rng1 = .Cells.Find(MyCell.Value)
If Not rng1 Is Nothing Then
If Not IsEmpty(MyCell.Offset(0, liczba).Value) Then
Else
strAddress = rng1.Address
Do
If .Cells.Find(MyCell.Value).Offset(0, 3).Value = "TAK" Then
MyCell.Offset(0, liczba).Value = MyCell.Offset(0, liczba).Value + 1
Else
MyCell.Offset(0, liczba).Value = 0
End If
Set rng1 = .Cells.FindNext(rng1)
Loop While rng1.Address <> strAddress
End If
End If
End With
Next
(and so on...)
End sub