AccessTr.neT

@feraz hocam yardımlarınız için teşekkür ederim. Konuyu taşıyabilirsiniz.

(13/09/2021, 23:21)Oğuz Türkyılmaz yazdı: [ -> ]@feraz hocam yardımlarınız için teşekkür ederim. Konuyu taşıyabilirsiniz.

Kod:

Type KaydetmeAlani
    val As Variant
    addr As String
End Type

Public arr() As KaydetmeAlani
Public awn As String
Public aws As String

Sub MakroCalistir_2()
    Dim say As Integer
    awn = ActiveCell.Parent.Parent.Name
    aws = ActiveCell.Parent.Name
   
    ReDim Preserve arr(1 To 33)
   
    Dim i As Integer
    With Sayfa1
        For i = 22 To 54
            say = say + 1
            If .Range("M" & i).Interior.ColorIndex = 7 Then
                arr(say).addr = Sayfa1.Cells(i, "M").Address
                arr(say).val = Sayfa1.Cells(i, "M").Formula
                If frm_bioclimatic.CheckBox2.Value = True Then .Cells(i, "M").Value = 0
               
            End If
        Next
    End With

End Sub
Sub MakroGeriAl_2()
    Dim j As Integer
    For j = LBound(arr) To UBound(arr)
        If Len(arr(j).addr) > 0 Then Sayfa1.Range(arr(j).addr).Formula = arr(j).val
    Next j
End Sub

Rica ederim.

(13/09/2021, 23:21)Oğuz Türkyılmaz yazdı: [ -> ]awn = ActiveCell.Parent.Parent.Name aws = ActiveCell.Parent.Name

Aslında buraya gerek yok ben silmeyi unutmuşum.
O kodlar sayda aktif yapılınca için geçerliydi onu silmiştim.Zten koddada bu kodlar geçersiz

Kodu böyle kullanın abey.Arr içinede aralık yazmaya gerek yok aslında 1 to 1  yeterli.

Sub MakroCalistir_2()

    Dim say As Integer, i As Long

    

    ReDim arr(1 To 1)

    

    With Sayfa1

        For i = 22 To 54

            say = say + 1

            ReDim Preserve arr(1 To say)

            If .Range("M" & i).Interior.ColorIndex = 7 Then

                arr(say).addr = .Cells(i, "M").Address

                arr(say).val = .Cells(i, "M").Formula

                If frm_bioclimatic.CheckBox2.Value = True Then .Cells(i, "M").Value = 0

            End If

        Next

    End With

End Sub