• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

İlgili Hücreye Veri Aktarma!!

REDonWHITE

REDonWHITE

Katılım
9 Haziran 2011
Mesajlar
19
Excel Vers. ve Dili
Office 2016
Değerli Üstadlar,

Başlıkta belirtiğim gibi, ekte göndermiş olduğum dosyada;
Sayfa2'deki Tabloda 3 kritere uyan satırın, TARİH sütunundaki ilgili hücreye
Sayfa1'deki girdiğim tarihlerin Buton yardımıyla aktarılması gerekiyor.

Çok uğraştım ama bir çözüm bulamadım!!.
Siz değerli üstadlardan yardım rica ediyorum.
Şimdiden teşekkür ediyorum.

 

Ekli dosyalar

Aşağıdaki kodları kullanabilirsiniz.
Kod: 
Sub ASKM_Veri_Getir()
Dim s1, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim SonSat1, SonSat2 As Long
SonSat1 = s1.Range("A" & Rows.Count).End(xlUp).Row
SonSat2 = s2.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To SonSat2
    For x = 6 To SonSat1
        If s1.Cells(i, "A") = s2.Cells(x, "H") And s1.Cells(i, "B") = s2.Cells(x, "F") And s1.Cells(i, "C") = s2.Cells(x, "G") Then
            s2.Cells(x, "O") = s1.Cells(i, 4)
        End If
    Next x
Next i
MsgBox "Veri aktarımı tamam...", vbInformation, "ASKM"
End Sub
 
Üstadım alakanızdan dolayı çok teşekkür ediyorum.

Verdiğiniz kodu uyguladım. Fakat;
Sayfa1'de girdiğim tarihi Sayfa2 TARİH sütunundaki tüm boş hücrelere atıyor.
Sayfa1'de örnek olması için bir tarih girmiştim.
Diğer kriterlerin tarihlerinide girdiğimizde ilgili hücreye atmasını istiyorum.
Mümkünse size zahmet anlattığım gibi yapabilirmiyiz?
 
Aşağıdaki kodlar ile normalde verileriniz gelmesi gerek. Ama siz formüller verileri çektirdiğiniz için aynı tarih geliyor.
Eğer amacınız öncelikle tarih değeri eksik olanları listeletmek ise formülsüz makro ile onu yapayım.
Kod: 
Private Sub CommandButton1_Click()
ASKM_Veri_Getir
End Sub
Sub ASKM_Veri_Getir()
Dim s1, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim SonSat1, SonSat2 As Long
SonSat1 = s1.Range("A" & Rows.Count).End(xlUp).Row
SonSat2 = s2.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To SonSat2
    If s2.Cells(i, "O") = "" Then
        For x = 6 To SonSat1
            If s1.Cells(x, "A") = s2.Cells(i, "H") And s1.Cells(x, "B") = s2.Cells(i, "F") And s1.Cells(x, "C") = s2.Cells(i, "G") Then
                s2.Cells(i, "O").Value = s1.Cells(x, 4).Value
                GoTo 10
            End If
        Next x
    End If
10:
Next i
MsgBox "Veri aktarımı tamam...", vbInformation, "ASKM"
End Sub
 
Evet dediğiniz gibi.
Sayfa1 Günlük rapor(kontrol) sayfası.
Sayfa2 ye veri girerken bazılarının tarihlerini daha sonra giriyoruz.
O yüzden hangi Sayfa2 de hangi verilerin tarihleri yoksa Sayfa1 açıldığında listelesin, bende tarihleri belli olanları girdikten sonra aktarsın istiyorum.
 
Üstad 4 nolu mesajdaki kodu girdim.
Yine Sayfa1'de girdiğim tarihleri ilgili hücrelere değilde;
En üstteki tarihi tüm boş hücrelere atıyor.
 
Sayfa1 in kod bölümüne aşağıdaki kodları girin. Sayfa2 den Sayfa1 e geçtiğinizde (Active ettiğinizde) kod otomatik çalışacaktır.
Kod: 
Private Sub Worksheet_Activate()
Dim s1, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim SonSat As Long
SonSat = s2.Range("O" & Rows.Count).End(xlUp).Row
On Error Resume Next
a = 6
s1.Range("A6:D" & [A65536].End(3).Row).ClearContents
For i = 6 To SonSat
    If s2.Cells(i, "O") = Empty Then
        s1.Cells(a, 1) = s2.Cells(i, "H")
        s1.Cells(a, 2) = s2.Cells(i, "F")
        s1.Cells(a, 3) = s2.Cells(i, "G")
        a = a + 1
    End If
Next i
MsgBox a - 6 & " adet plakada tarih girilmediği tespit edilmiş olup listelendi...", vbInformation, "ASKM"
End Sub
 
Hocam elinize, zihninize sağlık. Zahmet verdiğimin farkındayım. Hakkınızı helal edin lütfen.

Bu çalışma kitabında önemli olan;
Sayfa1'e listelenen verilerin karşısına girdiğim tarihleri,
Sayfa2'de karşılık gelen boş Tarih hücresine aktarılması.
 
Rica ederim.
Tamam öncelikle Sayfa2 den sayfa1 e geçtiğinizde tarihi eksik olanlar listelenecek. Siz oraya tarih girdiğinizde ve butona bastığınızda verileriniz sayfa2 ye gidecek. (Tarihler)
Dilerseniz aşağıdaki kodu iptal ederseniz temizleme işlemi yapmaz. Belki tarihleri girerken kontrol amacıyla tekrar sayfa2 ye geçiş yaparsanız girdiğiniz tarihler de temizlenmiş olmasın.
s1.Range("A6:D" & [A65536].End(3).Row).ClearContents (Ya başına tek tırnak ekleyin ya da tamamen silebilirsiniz.)
 
Üstad

1- #2 nolu mesajdaki kodu kullandığımda Sayfa1'deki son tarih hariç diğerlerini doğru atıyor.
2- Sayfa2'de alt satırlardaki boş tarihlerin hiçbirinin aktarmasını yapmıyor.
Size zahmet olacak kontrol etmeniz mümkünmü?
 
Örneğinizin son halini ekleyebilir misiniz.
 
Bu örnekde yalnızca 12. satır boş. Öncelikle satır dolu mu boş mu ona bakıyor kod. Boş ise işlem yap. Dolu ise gerek yok gibi.
 
Kodları aşağıdaki şekilde revize ederek hangi satıra veri geldiğini görmeniz için arka plana renk ekledim.
Kod: 
Sub ASKM_Veri_Getir()
Dim s1, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim SonSat1, SonSat2 As Long
SonSat1 = s1.Range("A" & Rows.Count).End(xlUp).Row
SonSat2 = s2.Range("A" & Rows.Count).End(xlUp).Row
Range("P6:P" & SonSat1).Interior.Color = xlNone
For i = 6 To SonSat2
    If s2.Cells(i, "O") = "" Then
        For x = 6 To SonSat1
            If s1.Cells(x, "A") = s2.Cells(i, "H") And s1.Cells(x, "B") = s2.Cells(i, "F") And s1.Cells(x, "C") = s2.Cells(i, "G") Then
                s2.Cells(i, "O").Value = s1.Cells(x, 4).Value
                s2.Cells(i, "p").Interior.Color = vbYellow
                GoTo 10
            End If
        Next x
    End If
10:
Next i
s2.Select
MsgBox "Veri aktarımı tamam...", vbInformation, "ASKM"
End Sub


Private Sub Worksheet_Activate()
Dim s1, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim SonSat As Long
SonSat = s2.Range("O" & Rows.Count).End(xlUp).Row
On Error Resume Next
a = 6
s1.Range("A6:D" & [A65536].End(3).Row).ClearContents
For i = 6 To SonSat
    If s2.Cells(i, "O") = Empty Then
        s1.Cells(a, 1) = s2.Cells(i, "H")
        s1.Cells(a, 2) = s2.Cells(i, "F")
        s1.Cells(a, 3) = s2.Cells(i, "G")

        a = a + 1
    End If
Next i
MsgBox a - 6 & " adet plakada tarih girilmediği tespit edilmiş olup listelendi...", vbInformation, "ASKM"
End Sub
 
Sayın Üstad ASKM

Verdiğiniz emeklerden ötürü çok teşekkür ederim.
Meslek hayatınızda arzu ettiğiniz ne varsa Allah C.C. hayırlısıyla nasip etsin.

Saygılar...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst