[Çözüldü] Onay Kutusu ile sayfaya veri çekme

[orhanacan]

Merhaba, sayfada satırda bulunan onay kutusu işaretli olanların başka sayfada listelenmesini nasıl sağlayabileceğim konusunda yardımcı olacak arkadaşlarım var mı acaba? Örnek Uygulamamda sorunu anlatmaya çalıştım. Amaç sayfada isteğe bağlı veriler satırlara girildiğinde en sonda bulunan onay kutularından seçme yaparak (seçilmiş olanların) diğer sayfaya isteğe bağlı sütun başlıkları altında alt alta nasıl sıralayabiliriz? Tabii bunun alternatif çözümünü sunacak arkadaşlarada teşekkürlerimi sunarım. Uygulamada sorunun çözümü anlaşılması adına makbule geçecektir. Saygılarımla...


(Çözüm içerek dosya eklendiğinden dolayı, buradaki ek silinmiştir. - Bülent)

[Bülent Öztürk]

Merhaba Orhan Bey.

Sayfanızda "CheckBox" yerine "Onay Kutusu" kullandık ve hücre bağlantılarını bulundukları satıra ayarladık.

Aşağıdaki kod ile sütunda işaretli olanları taratıp LISTE sayfasına gönderdik.

Kod: [Seç]

Sub SecilenleriGonderExcelce()
Dim bulent As Long
Dim son As Long
On Error GoTo hata
For bulent = 9 To Range("F65530").End(3).Row
    If Range("F" & bulent).Value = True Then
        son = Worksheets("LISTE").Range("A65530").End(xlUp).Row + 1
        Worksheets("LISTE").Range("A" & son) = Range("A" & bulent)
        Worksheets("LISTE").Range("B" & son) = Range("B" & bulent)
        Worksheets("LISTE").Range("C" & son) = Range("C" & bulent)
        Worksheets("LISTE").Range("D" & son) = Range("D" & bulent)
        Worksheets("LISTE").Range("E" & son) = Range("E" & bulent)
    End If
Next bulent
MsgBox "İşlem tamam.", vbInformation, "Excelce.Net"
Exit Sub
hata:
MsgBox Err.Description, vbCritical, "Hata oluştu:" & Err.Number
End Sub

Dosyanızın düzenlenmiş hali ektedir.

[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

[orhanacan]

Bülent hocam, Acizane sualim sitemizde ilk yardım isteğim olması bir yana öncelikle lütfen..! iltifat olarak kabul buyurmayın ama bilgi de insanımıza verdiğiniz hizmet, özveri ve bu ulvi hizmetteki sabrınızdan dolayı ayrıca teşekkürlerimi sunarım. Dünyanın en zor işi insanlara hizmet vermektir. (helekine karşılıksız) Bunu yaşayan biri olarak söylemek istedim. Herşeye rağmen teşbihte hata olmasın bilgisizlik tahta kurusu gibi ihtiyacı olanı yer bitirir. Günlerdir bu konunun, ihtiyacım olan bu sorunun cevabını aradım ve cevap verecek bir ustamızı bekledim. Ben, sorunuma cevap vermeniz bir yana ilgilendiğiniz için teşekkür ederim. Bilgi kulvarınızda yol aldığınız, hizmet ve yardımlarınızı esirgemeden çalışmalarınızdan dolayı sizleri tebrik eder, herşeyin gönlünüzce olmasını dilerim. Saygılarımla...

Ayrıca hocam, özür diliyerek uygulama istediğim gibi olmuş, Acaba..! bilgilerin aktarılan listede sıra numarası ile butona her tıkladığımızda aynı bilgileri tekrar gelmemesi için ne yapmamız gerektiği hususunda da örnek uygulamada açıklayabilirseniz memnun olurum. Hali hazır durumda bilgiler Liste sayfasına aktarıldığında tekrar butona bastığında aynı veriler varsa tekrar eklemese ve sıra numarasını 1 den başlatmak mümkün müdür? tekrar saygılarımla...

[Bülent Öztürk]

Onur verici sözleriniz için teşekkür ederim Orhan bey.   

Forumu açmamız yardımlaşma sebebiyle olduğundan, soru sormanız veya sorularınızı arttırmanız, devam ettirmenizde hiç bir sakınca yoktur.

Sorunuza gelince, dosyanızın yeni hali ektedir.

Kod: [Seç]

Sub SecilenleriGonderExcelce()
Dim bulent As Long
Dim son As Long, say As Long
Dim mukerrer As Range
On Error GoTo hata
say = 0
For bulent = 9 To Range("F65530").End(3).Row
    If Range("F" & bulent).Value = True Then
        son = Worksheets("LISTE").Range("B65530").End(xlUp).Row + 1
            For Each mukerrer In Worksheets("LISTE").Range("B3:B" & son)
                If mukerrer.Value = Range("B" & bulent) And _
                    mukerrer.Offset(0, 1).Value = Range("C" & bulent) And _
                    mukerrer.Offset(0, 2).Value = Range("D" & bulent) And _
                    mukerrer.Offset(0, 3).Value = Range("E" & bulent) Then
                    GoTo mevcut
                End If
            Next mukerrer
        'Worksheets("LISTE").Range("A" & son) = Range("A" & bulent)
        Worksheets("LISTE").Range("B" & son) = Range("B" & bulent)
        Worksheets("LISTE").Range("C" & son) = Range("C" & bulent)
        Worksheets("LISTE").Range("D" & son) = Range("D" & bulent)
        Worksheets("LISTE").Range("E" & son) = Range("E" & bulent)
        say = say + 1
    End If
mevcut:
Next bulent
MsgBox "İşlem tamam." & vbNewLine & say & " kayıt aktarıldı.", vbInformation, "Excelce.Net"
Exit Sub
hata:
MsgBox Err.Description, vbCritical, "Hata oluştu:" & Err.Number
End Sub
Sıra numarasını aldırmayıp, LISTE sayfasında formül ve koşullu biçimlendirme ile yapıp,
kayıt kontrolü için mevcut kodun arasına bir döngü de kontrol için eklemiş olduk.
Uzun listelerde çalışmayı yavaşlatabilir, bilginiz olsun.

[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

[orhanacan]

Bülent hocam, teşekkür ederim. Sorun çözülmüştür. Teşekkür ederim. Saygılarımla...

[Bülent Öztürk]

Rica ederim. Çözüldüğüne sevindim. 

Çalışmalarınızda başarılar.
Saygılar.