Tarih Bul Altındaki sütunu Sıfır ile doldur

[Feylosof]

Merhabalar;
Ekteki dosyada örnek üzerinde detaylı açıklama yaptım
Userformda buluna textboxa tarih yazınca dosyadaki ilgili tarihi bulup altını sıfır ile dolduracak. Tarihler formül ile gelmektedir.
Yardımlarınız için şimdiden teşekkürler.

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[Feylosof]

Sayın muygun tam istediğim gibi olmuş. Çok teşekkür ediyorum.

 

[Muzaffer Ali]

Bu da alternatif olsun.

Formun kod kısmına aşağıdaki kodları kopyalayın.

Private Sub CommandButton1_Click()
    Dim Bul As Range
    Dim Bulundu As Boolean
    For Each Bul In Range("C3:" & Cells(3, Cells(3, Columns.Count).End(xlToLeft).Column).Address).Address
        If Bul.Text = TextBox1.Text Then
            Bulundu = True
            Range(Cells(Bul.Row + 1, Bul.Column).Address & ":" & Cells(Cells(Rows.Count, "B").End(xlUp).Row, Bul.Column).Address) = "0"
        End If
    Next
    If Not Bulundu Then
        MsgBox "Girdiğiniz tarih bulunamıyor.", vbExclamation
    End If
End Sub

 

[Feylosof]

Merhaba;
Eki deneyin.
İyi çalışmalar.

Hocam bir sorum daha olacak bu soruyu bir önceki soru ile birlikte sormam gerekirken unuttum.
Sizin düzenlemenizi tekrar paylaşıyorum. Aynı tarihe denk gelecek şekilde ikinci sayfadaki sayıları birinci sayfanın ilgili sütununa taşımak için kod nasıl olmalıdır?

 

[Feylosof]

Bu da alternatif olsun.

Formun kod kısmına aşağıdaki kodları kopyalayın.

Private Sub CommandButton1_Click()
    Dim Bul As Range
    Dim Bulundu As Boolean
    For Each Bul In Range("C3:" & Cells(3, Cells(3, Columns.Count).End(xlToLeft).Column).Address).Address
        If Bul.Text = TextBox1.Text Then
            Bulundu = True
            Range(Cells(Bul.Row + 1, Bul.Column).Address & ":" & Cells(Cells(Rows.Count, "B").End(xlUp).Row, Bul.Column).Address) = "0"
        End If
    Next
    If Not Bulundu Then
        MsgBox "Girdiğiniz tarih bulunamıyor.", vbExclamation
    End If
End Sub

Sayın dalgalikur çok teşekkür ediyorum. Az önce yukarıdaki soruyu sizinle de paylaşmış olayım o halde.

 

[Muzaffer Ali]

2. sayfa boş.

 

[Feylosof]

@dalgalikur
Özür dilerim. Tekrar yükledim
@muygun

 

[Muzaffer Ali]

Formdaki bütün kodları silin aşağıdakileri kopyalayın.

Option Explicit

Private Sub CommandButton1_Click()
    Dim Bul As Range
    Dim BulunduKaynak As Boolean
    Dim BulunduHedef As Boolean
    Dim syfKaynak As Worksheet
    Dim syfHedef As Worksheet
    Dim KopyalanacakAlan As Range
    Set syfKaynak = ThisWorkbook.Worksheets("Sayfa2")
    Set syfHedef = ThisWorkbook.Worksheets("Sayfa1")
    For Each Bul In syfKaynak.Range("C3:" & syfKaynak.Cells(3, syfKaynak.Cells(3, Columns.Count).End(xlToLeft).Column).Address)
        If Bul.Text = TextBox1.Text Then
            BulunduKaynak = True
            Set KopyalanacakAlan = syfKaynak.Range(Cells(Bul.Row + 1, Bul.Column).Address & ":" & Cells(Cells(Rows.Count, "B").End(xlUp).Row, Bul.Column).Address)
            Exit For
        End If
    Next
    For Each Bul In syfHedef.Range("C3:" & syfHedef.Cells(3, syfHedef.Cells(3, Columns.Count).End(xlToLeft).Column).Address)
        If Bul.Text = TextBox1.Text Then
            BulunduHedef = True
            KopyalanacakAlan.Copy syfHedef.Cells(Bul.Row + 1, Bul.Column)
            Exit For
        End If
    Next
    If Not BulunduKaynak Then
        MsgBox "Girdiğiniz tarih " & syfKaynak.Name & " sayfasında bulunamıyor.", vbExclamation
    End If
    If Not BulunduHedef Then
        MsgBox "Girdiğiniz tarih " & syfHedef.Name & " sayfasında bulunamıyor.", vbExclamation
    End If
End Sub

 

[Feylosof]

Formdaki bütün kodları silin aşağıdakileri kopyalayın.

Option Explicit

Private Sub CommandButton1_Click()
    Dim Bul As Range
    Dim BulunduKaynak As Boolean
    Dim BulunduHedef As Boolean
    Dim syfKaynak As Worksheet
    Dim syfHedef As Worksheet
    Dim KopyalanacakAlan As Range
    Set syfKaynak = ThisWorkbook.Worksheets("Sayfa2")
    Set syfHedef = ThisWorkbook.Worksheets("Sayfa1")
    For Each Bul In syfKaynak.Range("C3:" & syfKaynak.Cells(3, syfKaynak.Cells(3, Columns.Count).End(xlToLeft).Column).Address)
        If Bul.Text = TextBox1.Text Then
            BulunduKaynak = True
            Set KopyalanacakAlan = syfKaynak.Range(Cells(Bul.Row + 1, Bul.Column).Address & ":" & Cells(Cells(Rows.Count, "B").End(xlUp).Row, Bul.Column).Address)
            Exit For
        End If
    Next
    For Each Bul In syfHedef.Range("C3:" & syfHedef.Cells(3, syfHedef.Cells(3, Columns.Count).End(xlToLeft).Column).Address)
        If Bul.Text = TextBox1.Text Then
            BulunduHedef = True
            KopyalanacakAlan.Copy syfHedef.Cells(Bul.Row + 1, Bul.Column)
            Exit For
        End If
    Next
    If Not BulunduKaynak Then
        MsgBox "Girdiğiniz tarih " & syfKaynak.Name & " sayfasında bulunamıyor.", vbExclamation
    End If
    If Not BulunduHedef Then
        MsgBox "Girdiğiniz tarih " & syfHedef.Name & " sayfasında bulunamıyor.", vbExclamation
    End If
End Sub

Sayın @dalgalikur akşam eve dönünce inceleyeceğim inşallah gelişmelerden haberdar edeceğim

 

[Feylosof]

Sayın @dalgalikur ilgi ve yardımlarınız için çok teşekkür ederim. Kod gayet güzel çalışıyor. Ancak esas dosyamda Sayfa 2 deki rakamsal veriler formülle geldiği için sayfa 1 e alırken formulle birlikte yapıştırıyor. Bunu sadece değer olarak aktarma şansımız var mı. Eğer bunu yapabilirsek amacım tam o zaman gerçekleşmiş olacak.

 

[Muzaffer Ali]

KopyalanacakAlan.Copy syfHedef.Cells(Bul.Row + 1, Bul.Column)

Satırını silin yerine aşağıdakileri kopyalayın.

KopyalanacakAlan.Copy
syfHedef.Cells(Bul.Row + 1, Bul.Column).PasteSpecial Paste:=xlPasteValues

 

[Feylosof]

Sayın @dalgalikur çok teşekkür ederim. Şimdi harika oldu. Minnet ve şükranlarımla...

 

[Muzaffer Ali]

Rica ederim kolay gelsin.