Çözüldü Şarta bağlı veri kopyalama hakkında.

[yesimgurol]

Merhabalar;
Ekte yer örnek dosyamda,

"B" sütununda yer alan değerleri ;
- "veri" sayfasında "A" sütununda arıyorum. (genelde alt alta bulunuyor)
- Bulduğumda öncelikle "C" sütununda herhangi bir değerin olup olmadığına bakıyorum.
- Değer var ise ; "D" sütunundaki değeri "özet" sayfasında "C" sütununa alıyorum. Eğer başka değer var ise ("veri" sayfasındaki C sütununda) o değeri de "özet" sayfasında D sütununa yazıyorum.
- Değer yok ise herhangi bir işlem yapmıyorum.

Bu olayı 1000 satırlık hasta sonuçlarımda maalesef tek tek yapmak zorunda olduğumdan oldukça zaman alıcı oluyor. :-( Amacım makro yardımı ile bu işlemi bir buton yardımı ile yapabilmek.

 

[AdemCan]

Merhaba, veri sayfası C sütununda boş görünen bazı hücreler, içi dolu olarak görünüyor.
Öncelikle bu hücreleri düzenlemeniz gerekir.
Yinelenen verileri düzenle butonuna

Sheets("veri").Range("C:C").Replace What:=" ", Replacement:=""

bu satırı eklemeniz yeterli ya da bul ve değiştir ile de boşlukları kaldırabilirsiniz.

Spoyler: Ekran Görüntüsü

Sonuçları değerlendir butonu içinde bu kodları kullanabilirsiniz.

Sub test_ara()
Dim s1 As Worksheet, s2 As Worksheet
Dim i As Long, x As Long, son As Long, sonb As Long, sonA As Long, say As Long, bul As Variant

Set s1 = Sheets("veri"): Set s2 = Sheets("özet")
son = s1.Range("A" & Rows.Count).End(3).Row
sonb = s2.Range("B" & Rows.Count).End(3).Row

For i = 2 To sonb
s = 3
    say = WorksheetFunction.CountIf(s1.Range("A2:A" & son), s2.Cells(i, "B"))
    Set bul = s1.Range("A1:A" & son).Find(s2.Cells(i, "B"), LookAt:=xlWhole)
    If Not bul Is Nothing Then
        bul = bul.Row
        sonA = (say - 1) + bul
        For x = bul To sonA
            If s1.Range("C" & x) <> "" Then
                s2.Cells(i, s) = s1.Range("D" & x)
                s = s + 1
            End If
        Next x
    End If
Next i

End Sub

 

[yesimgurol]

Merhaba, Adem bey
Öncelikle ilginiz için çok teşekkür ederim. 1-2 saate kadar deneme fırsatım olacak :-( cevabınıza istinaden bilgi vermek istedim Saygılarımla.

 

[yesimgurol]

Merhaba, veri sayfası C sütununda boş görünen bazı hücreler, içi dolu olarak görünüyor.
Öncelikle bu hücreleri düzenlemeniz gerekir.
Yinelenen verileri düzenle butonuna

Sheets("veri").Range("C:C").Replace What:=" ", Replacement:=""

bu satırı eklemeniz yeterli ya da bul ve değiştir ile de boşlukları kaldırabilirsiniz.

Spoyler: Ekran Görüntüsü

Ekli dosyayı görüntüle 250445

Sonuçları değerlendir butonu içinde bu kodları kullanabilirsiniz.

Sub test_ara()
Dim s1 As Worksheet, s2 As Worksheet
Dim i As Long, x As Long, son As Long, sonb As Long, sonA As Long, say As Long, bul As Variant

Set s1 = Sheets("veri"): Set s2 = Sheets("özet")
son = s1.Range("A" & Rows.Count).End(3).Row
sonb = s2.Range("B" & Rows.Count).End(3).Row

For i = 2 To sonb
s = 3
    say = WorksheetFunction.CountIf(s1.Range("A2:A" & son), s2.Cells(i, "B"))
    Set bul = s1.Range("A1:A" & son).Find(s2.Cells(i, "B"), LookAt:=xlWhole)
    If Not bul Is Nothing Then
        bul = bul.Row
        sonA = (say - 1) + bul
        For x = bul To sonA
            If s1.Range("C" & x) <> "" Then
                s2.Cells(i, s) = s1.Range("D" & x)
                s = s + 1
            End If
        Next x
    End If
Next i

End Sub

Adem bey, tam istediğim şekilde olmuş elinize sağlık, çok teşekkür ederim. Saygılarımla.

 

[AdemCan]

Rica ederim.