Excel VBA 保存范围参考

Question

我有一系列单元格，我正在扫描这些单元格是否有公式。 当它发生时，我想保存列字母和行号，即 E14、E18、F18、N18（参考）做一本字典。 循环遍历特定范围后，我想选择保存在字典中的单元格，以便稍后删除所选单元格中带有公式的所有单元格。

我坚持保护单元格对字典的引用的部分。 示例中的范围只是示例范围。

Sub check_formula_empty()

Dim cell As Range
Dim i As Integer
Dim rng As Range
Set rng = Range("E13:N19")

For i = 1 To rng.Cells.Count

    If rng.Cells(i).HasFormula = True And rng.Cells(i).Offset(-6, 0) = "A" Then

   'save reference range to Dictionary
    
    ElseIf rng.Cells(i).HasFormula = False And rng.Cells(i).Offset(-6, 0) = "F" Then
        
    rng.Cells(i).Offset(-4, 0).Copy _
    Destination:=rng.Cells(i)

    End If

Next

'Here I want to run the "Select my saved range from the Dictionary" and run "delete formulas"

End Sub

Answer 1

您可以为此目的收集一个集合。您提到了一本字典，但就您的目的而言，键并不那么重要，您只需要一个项目列表（集合支持两者）

Sub check_formula_empty()

Dim cell As Range
Dim i As Integer
Dim rng As Range
Set rng = Range("E13:N19")
dim reflist as Collection
Set reflist = new Collection
For i = 1 To rng.Cells.Count

    If rng.Cells(i).HasFormula = True And rng.Cells(i).Offset(-6, 0) = "A" Then

   'save reference range to Dictionary
        refList.Add rng.Cells(i)
    ElseIf rng.Cells(i).HasFormula = False And rng.Cells(i).Offset(-6, 0) = "F" Then
        
    rng.Cells(i).Offset(-4, 0).Copy _
    Destination:=rng.Cells(i)

    End If

Next

'Here I want to run the "Select my saved range from the Dictionary" and run "delete formulas"

Dim oneCell as Range

    foreach oneCell in refList
        oneCell.Value = vbEmpty
    next
End Sub

如您所见，我们首先将完整的单元格添加到集合中（它是一个引用的对象），然后您可以根据自己的喜好在 foreach 循环中使用它及其所有属性

Answer 2

因此，我正在努力解决这个问题，以便比在每列中循环 2-3 倍更快地运行 VBA。

我当前努力解决的问题是：定义的范围“nof”或“DBRW”不断增加，当解析我的最终代码（删除或将公式复制到联合范围）时，会选择整个联合范围并因此，公式会被覆盖整个范围，而不是从一列循环到另一列并使用该列中定义的公式，该公式在固定行 (Cells(6, n)) 中可用。

Option Explicit

Sub Test3()

Dim i As Integer
Dim n As Integer
Dim x As Integer

Dim DBRW As Range
Dim DBRWrange(1 To 32) As Range
Dim nof As Range
Dim nofRange(1 To 32) As Range
Dim rangef As Range

    For n = 5 To 6
        For i = 13 To 20
            If Cells(i, n).HasFormula = True And Cells(7, n) = "A" Then
               
        
                Set DBRWrange(i) = Cells(i, n)
                    If DBRW Is Nothing Then
                        Set DBRW = DBRWrange(i)
                        Else
                        Set DBRW = Union(DBRW, DBRWrange(i))
                    End If
                
            ElseIf Cells(i, n).HasFormula = False And Cells(7, n) = "F" Then
            
                Set nofRange(i) = Cells(i, n)
                    If nof Is Nothing Then
                        Set nof = nofRange(i)
                        Else
                        Set nof = Union(nof, nofRange(i))
                    End If

            End If

        Next i
        
        Set rangef = Cells(6, n)

        rangef.Copy nof
        

'Ranges in nof and DBRW are kept (incremented), is there a way to "refresh" the Union reference, to restart creating the range from after this step?

    Next n

End Sub


´´´

Answer 3

所以我已经解决了我的问题，对于未来的谷歌用户来说，这可能会有所帮助:)

Public Sub copy_paste_delete()

Dim i As Integer
Dim n As Integer

Dim DBRW As Range
Dim DBRWrange(1 To 150) As Range
Dim nof As Range
Dim nofRange(1 To 150) As Range
Dim rangef As Range

Application.ScreenUpdating = False

Worksheets("Tab1").Activate
Range("K29").Select

Set DBRW = Nothing
Set nof = Nothing

    For n = 61 To 75
    
    Set nof = Nothing
    Set DBRW = Nothing
    
        For i = 33 To 38
            If Cells(i, n).HasFormula = True And Cells(6, n) = "F" Then
        
                Set DBRWrange(i) = Cells(i, n)
                    If DBRW Is Nothing Then
                        Set DBRW = DBRWrange(i)
                        Else
                        Set DBRW = Union(DBRW, DBRWrange(i))
                    End If
                
                
            ElseIf Cells(i, n).HasFormula = False And Cells(6, n) = "A" And Cells(7, n) = "Done" Then
            
                Set nofRange(i) = Cells(i, n)
                     If nof Is Nothing Then
                        Set nof = nofRange(i)
                        Else
                        Set nof = Union(nof, nofRange(i))
                    End If
            End If
        Next i
                        Set rangef = Cells(19, n)
                        
                        On Error Resume Next
                        
                        rangef.Copy nof
   
    Next n

DBRW.Select
'Do some stuff

Application.ScreenUpdating = True

End Sub