Çözüldü Kesişen hücreye aktarma

[sirkülasyon]

"Sayfa2" E2: 'P2 aralığında aylar yazılı
C sütununda da 3. Satırdan itibaren isimler yazılı.
Textbox1 değerini C sütununda ComboBox2 değerini de E2: 'P2 aralığında arayacak.
Her iki değerin Kesiştiği hücreye textbox3 deki rakamı üst üste toplarak aktaracak.
Bu işlemi gerçekleştirecek bir kod için yardımci olabilir misiniz?

 

[muhasebeciyiz]

Private Sub Worksheet_Change()
  
    Dim txtValue As String
    Dim cmbValue As String
    txtValue = TextBox1.Value
    cmbValue = ComboBox2.Value
    
    Dim cell As Range
    For Each cell In Range("E2:P2")
        
        If cell.Value = cmbValue Then
            
            Dim rowNum As Long
            For rowNum = 3 To Range("C" & Rows.Count).End(xlUp).Row
                
                If Cells(rowNum, "C").Value = txtValue Then
                    
                    Dim resultCell As Range
                    Set resultCell = Intersect(cell.Row, Range(Cells(rowNum, "C"), Cells(rowNum, "C")))
                    
                    If Not IsEmpty(resultCell) Then
                        resultCell.Value = resultCell.Value + TextBox3.Value
                    End If
                    Exit For
                End If
            Next rowNum
            Exit For
        End If
    Next cell

End Sub

Lütfen Deneyiniz

 

[muhasebeciyiz]

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sayfa2")
    
    Dim rowNumber As Long
    Dim colNumber As Long
    Dim targetCell As Range
    
    Dim searchName As String
    Dim searchMonth As String
    Dim addValue As Double
    
    searchName = TextBox1.Value
    searchMonth = ComboBox2.Value
    addValue = CDbl(TextBox3.Value)   
    
    On Error Resume Next
    rowNumber = ws.Columns("C").Find(What:=searchName, LookIn:=xlValues, LookAt:=xlWhole).Row
    On Error GoTo 0   
    
    On Error Resume Next
    colNumber = ws.Range("E2:P2").Find(What:=searchMonth, LookIn:=xlValues, LookAt:=xlWhole).Column
    On Error GoTo 0   
    
    If rowNumber > 0 And colNumber > 0 Then
        Set targetCell = ws.Cells(rowNumber, colNumber)
        targetCell.Value = targetCell.Value + addValue
    Else
        MsgBox "Aranan değerler bulunamadı.", vbExclamation
    End If
End Sub

1. Soldaki proje penceresinden, ilgili çalışma kitabınızı seçin ve bir form ekleyin (UserForm).
2. Forma üç adet TextBox (TextBox1, TextBox3) ve ComboBox (ComboBox2) ekleyin.
3. Forma bir adet CommandButton ekleyin ve üzerine çift tıklayarak yukarıdaki kodu yapıştırın.
4. ComboBox2'nin içeriğini uygun aylarla doldurun (örneğin, Form Initialize olayında).

Bu şekilde, form üzerindeki butona tıklandığında, belirtilen işlemler gerçekleştirilmiş olacaktır. Lütfen deneyiniz

 

[sirkülasyon]

Ellerin dert görmesin. Teşekkür ederim.