Makro güncelleme

[igultekin2000]

Merhaba,
CTRL ile seçtiğim hücre sabit kalarak mause ile muhtelif hücrelerdeki değeri tıklayarak ilk seçili hücrede toplamının alınması sağlanıyor. Ancak bu makroda üçüncü tıkladığım hücreyi toplam dahil ediyor ancak ikinci yani ilk toplama dahil ettiğim değeri siliyor. Sonrasında sorunsuz hücreleri tıkladıkça toplama dahil ediyor. Üçüncü tıklamada, ikinci tıklamadaki değeri silmemesini nasıl yapılabilir.
Makroda nasıl bir güncelleme yapılabilir.

Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Function IsCtrlPressed() As Boolean
    IsCtrlPressed = (GetKeyState(vbKeyControl) And &H8000) <> 0
End Function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static previousSelection As Range
    Dim total As Double
    Dim cell As Range

    ' Ctrl tuşuna basılı mı kontrol et
    If IsCtrlPressed() Then
        If previousSelection Is Nothing Then
            ' İlk seçimde önceki seçimi kaydet
            Set previousSelection = Target
        Else
            ' Önceki seçimdeki hücreleri temizle
            previousSelection.ClearContents
            'Yeniden toplama yapmadan önce total değerini sıfırla
            total = 0
        End If

        ' Seçilen hücrelerin değerlerini toplamak için
        For Each cell In Target
            ' Tek bir hücre olduğunda işlem yap
            If cell.Cells.Count = 1 Then
                total = total + cell.Value
            End If
        Next cell

        ' Tıklanan hücreye toplam değeri yaz
        Target.Cells(1, 1).Value = total
    Else
        ' Ctrl tuşu basılı değilse önceki seçimi temizle
        Set previousSelection = Nothing
    End If
End Sub

 

[Muzaffer Ali]

Merhaba.

Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Function IsCtrlPressed() As Boolean
    IsCtrlPressed = (GetKeyState(vbKeyControl) And &H8000) <> 0
End Function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Toplam As Double
    Dim Hucreler As Range
    Static BirinciHucre As Range
    Static BirinciHucreEskiDegeri As Long
    If IsCtrlPressed() Then
        If BirinciHucre Is Nothing Then
            Set BirinciHucre = Target(1, 1)
            BirinciHucreEskiDegeri = Target.Value
        End If
        For Each Hucreler In Target
            If Hucreler.Address = BirinciHucre.Address Then
                Toplam = Toplam + BirinciHucreEskiDegeri
            Else
                Toplam = Toplam + Hucreler.Value
            End If
        Next
        BirinciHucre.Value = Toplam
    Else
        Set BirinciHucre = Nothing
        Toplam = 0
    End If
End Sub

 

[igultekin2000]

Teşekkür ederim, sorunsuz çalışıyor. Çoğu zaman unutarak her ilk tıklamada veri siliniyordu. İyi çalışmalar