Excel Vba Forum - Excelce.Net

SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Çözülen Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: drejan62 - 06 Mayıs 2010, 10:03:50

Başlık: [Çözüldü] Aynı değeri içeren satırları saçme
Gönderen: drejan62 - 06 Mayıs 2010, 10:03:50

Merhabalar,
Ekteki listede görüleceği gibi, G ve H sütunlarında aynı değerleri içeren satırları seçip paror sayfasına aktarabilirmiyiz.
Teşekkürler

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

Başlık: Ynt: Aynı değeri içeren satırları saçme
Gönderen: Bülent Öztürk - 06 Mayıs 2010, 11:10:34

Merhaba Ercan Bey,

Kodu bir düğmeye atayıp çalıştırın;

Kod: [Seç]

Sub Excelce_Aynilari_Bul_Aktar()
Dim excelce_borc As Range, excelce_alacak As Range
excelce_basla:
For Each excelce_borc In Worksheets("liste").Range("G2:G" & Worksheets("liste").Range("G65530").End(3).Row)
    If excelce_borc = 0 Then GoTo excelce_ileri
    For Each excelce_alacak In Worksheets("liste").Range("H2:H" & Worksheets("liste").Range("H65530").End(3).Row)
         If excelce_borc <> 0 And excelce_borc = excelce_alacak Then
            rapor_son = Worksheets("rapor").Range("A65530").End(3).Row + 1
            excelce_borc.EntireRow.Cut Worksheets("rapor").Range("A" & rapor_son)
            excelce_alacak.EntireRow.Cut Worksheets("rapor").Range("A" & rapor_son + 1)
        GoTo excelce_basla
        End If
    Next excelce_alacak
excelce_ileri:
Next excelce_borc
MsgBox "İşlem tamam.", vbInformation, "Excelce.Net"
End Sub


Başlık: Ynt: Aynı değeri içeren satırları saçme
Gönderen: drejan62 - 06 Mayıs 2010, 11:31:53

Alıntı yapılan: Bülent Öztürk - 06 Mayıs 2010, 11:10:34

Merhaba Ercan Bey,

Kodu bir düğmeye atayıp çalıştırın;

Teşekkürler Bülent bey harikasınız.
Çok önemli değil ama aynı olan satırları taşımak yerine kopyalasak olurmu acaba.
çok sağolun..

Başlık: Ynt: Aynı değeri içeren satırları saçme
Gönderen: Bülent Öztürk - 06 Mayıs 2010, 11:44:14

Rica ederim. Siz de sağolun.

Ayrıca, o sizin kendi harikalığınız. ;)

Kopyalamak için;
Cut yazan yerleri Copy olarak değiştirin.
Ama aynı değerler varsa sorun çıkabilir.
Kopyalanan satırları, daha önce kopyalandığını belirtmek için işaretlettirmek gerekir.

 

Başlık: Ynt: Aynı değeri içeren satırları saçme
Gönderen: drejan62 - 06 Mayıs 2010, 11:53:27

Alıntı yapılan: Bülent Öztürk - 06 Mayıs 2010, 11:44:14

Rica ederim. Siz de sağolun.

Ayrıca, o sizin kendi harikalığınız. ;)

Kopyalamak için;
Cut yazan yerleri Copy olarak değiştirin.
Ama aynı değerler varsa sorun çıkabilir.
Kopyalanan satırları, daha önce kopyalandığını belirtmek için işaretlettirmek gerekir.

Aman kalsın o zaman :))
teşekkürler tekrar

Başlık: Ynt: Aynı değeri içeren satırları saçme
Gönderen: Bülent Öztürk - 06 Mayıs 2010, 12:09:10

Şöyle bir şey yapılabilir;

Kod: [Seç]

Sub Excelce_Aynilari_Bul_Kopyala_Aktar()
Dim excelce_borc As Range, excelce_alacak As Range
For Each excelce_borc In Worksheets("liste").Range("G2:G" & Worksheets("liste").Range("G65530").End(3).Row)
    If excelce_borc = 0 Then GoTo excelce_ileri
    For Each excelce_alacak In Worksheets("liste").Range("H2:H" & Worksheets("liste").Range("H65530").End(3).Row)
         If excelce_borc <> 0 And excelce_borc = excelce_alacak And excelce_alacak.Font.Bold = False Then
            rapor_son = Worksheets("rapor").Range("A65530").End(3).Row + 1
            excelce_borc.EntireRow.Copy Worksheets("rapor").Range("A" & rapor_son)
            excelce_alacak.EntireRow.Copy Worksheets("rapor").Range("A" & rapor_son + 1)
            excelce_borc.Font.Bold = True
            excelce_alacak.Font.Bold = True
        End If
    Next excelce_alacak
excelce_ileri:
Next excelce_borc
MsgBox "İşlem tamam.", vbInformation, "Excelce.Net"
End Sub

Kopyalananları koyu yaparız, karşılaştırıken koyu olmayanlara bakarız.  ;)

Başlık: Ynt: Aynı değeri içeren satırları saçme
Gönderen: drejan62 - 06 Mayıs 2010, 12:19:55

Alıntı yapılan: Bülent Öztürk - 06 Mayıs 2010, 12:09:10

Şöyle bir şey yapılabilir;

Kod: [Seç]

Sub Excelce_Aynilari_Bul_Kopyala_Aktar()
Dim excelce_borc As Range, excelce_alacak As Range
For Each excelce_borc In Worksheets("liste").Range("G2:G" & Worksheets("liste").Range("G65530").End(3).Row)
    If excelce_borc = 0 Then GoTo excelce_ileri
    For Each excelce_alacak In Worksheets("liste").Range("H2:H" & Worksheets("liste").Range("H65530").End(3).Row)
         If excelce_borc <> 0 And excelce_borc = excelce_alacak And excelce_alacak.Font.Bold = False Then
            rapor_son = Worksheets("rapor").Range("A65530").End(3).Row + 1
            excelce_borc.EntireRow.Copy Worksheets("rapor").Range("A" & rapor_son)
            excelce_alacak.EntireRow.Copy Worksheets("rapor").Range("A" & rapor_son + 1)
            excelce_borc.Font.Bold = True
            excelce_alacak.Font.Bold = True
        End If
    Next excelce_alacak
excelce_ileri:
Next excelce_borc
MsgBox "İşlem tamam.", vbInformation, "Excelce.Net"
End Sub

Kopyalananları koyu yaparız, karşılaştırıken koyu olmayanlara bakarız.  ;)

Eyvallah üstad
sağol

Başlık: Ynt: Aynı değeri içeren satırları saçme
Gönderen: Bülent Öztürk - 06 Mayıs 2010, 12:21:07

Rica ederim.  ;)