• DİKKAT

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

1.Sheet'te YOK Yazıyorsa, 2.Sheet'ten Karşılığı Olan Veriyi Çeksin

A

adonishan

Katılım
17 Nisan 2012
Mesajlar
10
Excel Vers. ve Dili
2010
Arkadaşlar biraz komplike olduğuna inandığım bir şey var, bilmiyorum Excel'den yapılıyor mu, yapılıyorsa ne kadar zor. Ama yapabilen olursa gerçekten çok mutlu olacağım.

Yapmak istediğim şey eğer Sheet1'in içindeki herhangi bir hücre içerisinde YOK yazıyorsa (hücre boş değil arkadaşlar, YOK yazıyor); Sheet 2'de karşılık gelen hücreyi o YOK yazan hücrenin yerine yazsın. Fakat bunu sağlaması için YOK hücresini arama yapması haricinde başka şeyler de yapması gerekiyor hâliyle:

Resimli bir şekilde anlatırsam sanırım daha doğru bir şekilde kendimi ifade edebilirim.

1.Resim - Sheet1'den & 2.Resim Sheet2'den.

m1r.png

el5q.png


Gördüğünüz gibi =Sheet1!H6 hücresinde YOK yazıyor, şimdi benim yapmasını istediğim şey, bu YOK yazan hücrenin "Konumunun, Yılının, Ayının, Gününün ve Saatinin (=Sheet1!H6 hücresinin konumu kırmızıyla yazan G, diğerleri de gördüğünüz gibi sırasıyla 2009, 5, 26, 3)" aynısını Sheet2'de taraması, eğer tıpa tıp aynısını bulursa oradaki Değeri Sheet1'de YOK yazan ile değiştirmesi. 2.resime baktığımızda Sheet2!B9:F9 değerleri tamamiyle uyuyor. Bu da demek oluyor ki, Sheet1'de YOK yazan yere 11 gelecek.

Bir tane daha örnek verecek olursam:

Sheet1!J6'da da YOK yazıyor. Bunun sırasıyla konumunu, yılını, ayını, gününü, saatini yazalım.

Konum: H
Sene: 2009
Ay: 5
Gün: 26
Saat: 3

Yani bu değerlerin aynısını Sheet2'de bulmasını istiyorum, bu değerlerin aynısı 2.resimde görebileceğiniz gibi "=Sheet2!B4:F4" arasında var. O zaman Sheet1!J6'da yazan "YOK"un yerini =Sheet2!G4'deki 7 alacak.

Umarım derdimi anlatabilmişimdir. Yardımcı olacak arkadaşlara şimdiden teşekkür eder, iyi günler dilerim.
 
Son düzenleme:
Aşağıdaki kodu deneyiniz.

Kod: 
Option Explicit

Sub AKTAR()
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Dim Veri As Range, BUL As Range, ADRES As String
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
    
    For Each Veri In S1.Range("F3:U" & S1.Cells(Rows.Count, 2).End(3).Row)
        If Veri.Value = "NULL" Then
            Set BUL = S2.Range("F:F").Find(S1.Cells(2, Veri.Column))
            If Not BUL Is Nothing Then
                ADRES = BUL.Address
                Do
                    If S2.Cells(BUL.Row, "B") = S1.Cells(Veri.Row, "B") And _
                        S2.Cells(BUL.Row, "C") = S1.Cells(Veri.Row, "C") And _
                        S2.Cells(BUL.Row, "D") = S1.Cells(Veri.Row, "D") And _
                        S2.Cells(BUL.Row, "E") = S1.Cells(Veri.Row, "E") Then
                        Veri.Value = S2.Cells(BUL.Row, "G")
                    End If
                    Set BUL = S2.Range("F:F").FindNext(BUL)
                Loop While Not BUL Is Nothing And BUL.Address <> ADRES
            End If
        End If
    Next
                    
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Korhan Ayhan' Alıntı:
Aşağıdaki kodu deneyiniz.

Kod: 
Option Explicit

Sub AKTAR()
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Dim Veri As Range, BUL As Range, ADRES As String
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
    
    For Each Veri In S1.Range("F3:U" & S1.Cells(Rows.Count, 2).End(3).Row)
        If Veri.Value = "NULL" Then
            Set BUL = S2.Range("F:F").Find(S1.Cells(2, Veri.Column))
            If Not BUL Is Nothing Then
                ADRES = BUL.Address
                Do
                    If S2.Cells(BUL.Row, "B") = S1.Cells(Veri.Row, "B") And _
                        S2.Cells(BUL.Row, "C") = S1.Cells(Veri.Row, "C") And _
                        S2.Cells(BUL.Row, "D") = S1.Cells(Veri.Row, "D") And _
                        S2.Cells(BUL.Row, "E") = S1.Cells(Veri.Row, "E") Then
                        Veri.Value = S2.Cells(BUL.Row, "G")
                    End If
                    Set BUL = S2.Range("F:F").FindNext(BUL)
                Loop While Not BUL Is Nothing And BUL.Address <> ADRES
            End If
        End If
    Next
                    
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

Korhan Bey, sanırım yaptığım bir hatadan dolayı istediğim gibi olmadı.

Sizden başka bir şey isteyeceğim izninizle, eğer bir columnda YOK yazıyorsa, onun bağlı olduğu Row'u tamamiyle silmesini istiyorum. Bunu yapabilir misiniz rica etsem?
 
Merhaba,

Dosyanızı açtığımda bende YOK yerine NULL yazıyordu. Sorun bununla ilgili olabilir mi?

Ayrıca 2. isteğinizde YOK dediğiniz değerlerin satırlarında sayısal değerlerde var ilgili satırı sildirirsek bu değerlerde silinecek! İstediğiniz işlem bu mu?
 
Korhan Bey yanlış dosyayı eklemişim hata ben de, kusura bakmayın.

2.sheet'de ki Column'larında YOK yazanların Row'larında yazan her şey gitsin. O değerlerde silinsin yani dediğiniz gibi, sorun değil.

Yalnız bu makro işleminedn pek anlamıyorum, acaba sheet 2'de her şeyi tarayacak şekilde yapabilir misiniz? Yani bir sınırı olmasın - zaten belki de o şekilde yapıyorsunuzdur da dediğim gibi anlamadığım için koda baktığımda ayırt edemiyorum.
 
Aslında bu işlem için makroya ihtiyaç yok. Filtre uygulayıp kalan satırları silebilirsiniz.

Yine de kodu veriyorum. Verilerinizi yedekleyip aşağıdaki kodu deneyiniz.

Kod: 
Sub SIL()
    Dim X As Long
    
    Application.ScreenUpdating = False
    
    With Sheets("Sheet2")
        For X = .Cells(Rows.Count, 2).End(3).Row To 3 Step -1
            If .Cells(X, "G") = "NULL" Then
                .Rows(X).Delete
            End If
        Next
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Korhan Bey tekrar merhaba,

Öncelikle sarfettiğiniz emek için size teşekkür ediyorum. VBN konusunda hiçbir bilgim yok sadece Java programlama dilinde kısa bir geçmişim var. İlk yazdığınız kod hakkında birkaç şey sormak istiyorum:

1-)Set S1 = Sheets("Sheet1")
Set S2 = Sheets("Sheet2")

Burada yazan Sheet1 ve Sheet2 adını değiştirip başka bir Excel dosyasında kullanmaya çalışıyorum, ve bu Excel dosyasında sheetlerin karşılığı A ve B olduğu için A ve B yaptım. Yani:

Set S1 = Sheets("A")
Set S2 = Sheets("B")

oldu.

2-) Kodun aşağı kısmında verileri karşılaştıracağı Columnlar tamamiyle aynı.

If S2.Cells(BUL.Row, "B") = S1.Cells(Veri.Row, "B") And _
S2.Cells(BUL.Row, "C") = S1.Cells(Veri.Row, "C") And _
S2.Cells(BUL.Row, "D") = S1.Cells(Veri.Row, "D") And _
S2.Cells(BUL.Row, "E") = S1.Cells(Veri.Row, "E") Then
Veri.Value = S2.Cells(BUL.Row, "G")

Then kısmına kadar olan yerlerin değerleri, ikinci Excel dosyasında da aynı dediğim gibi. Yani diğer Excel dosyasında da B columnda Sene, C columnda Ay, D columnda Gün, E columnda Saat yazıyor, tek fark bu sefer değeri G'den değil H columndan çekecek olması.

If S2.Cells(BUL.Row, "B") = S1.Cells(Veri.Row, "B") And _
S2.Cells(BUL.Row, "C") = S1.Cells(Veri.Row, "C") And _
S2.Cells(BUL.Row, "D") = S1.Cells(Veri.Row, "D") And _
S2.Cells(BUL.Row, "E") = S1.Cells(Veri.Row, "E") Then
Veri.Value = S2.Cells(BUL.Row, "H")

onu da bu şekilde düzelttim. Acaba başka yapmam gereken bir şey mi var? Geri kalan hiçbir şeye dokunmadım kodda. Ama olmuyor bir hata mı yapıyorum acaba? Bu yeni Excel dosyası çok daha geniş bir dosya, hem biraz özel hem de dosya boyutu çok büyük olduğundan paylaşmak istemiyorum. Bir de Excel'im İngilizce pek sanmıyorum kodun geneline baktığımda ama acaba o tepedeki Sub AKTAR kısmını mı düzeltmem gerekiyor yoksa?

---

2.Düzenleme:

Kodu çalıştırmaya çalıştığımda mı bir hata yapıyorum acaba? A sheetinin üstüne sağ tıklayıp View Code diyorum, sonra kodu yapıştırıp Run'a basıyorum, yaptığım işlemde bir hata var mı?

Not: Yeni excel dosyasında NULL yazıyor, değiştirmek istediklerim.

---

3.Düzenleme:

Sanırım yeni excel dosyasında Row 2'den değil de 3'den başladığı için olmuyordu şimdi, bir row geri kaydırdım tıkandı bilgisayar olacak gibi. Oldu arkadaşlar, şimdi sadece bunu Row 3 yapmak için nereyi düzeltmek gerekiyor ona bakacağım.
 
Son düzenleme:
Vermiş olduğum kod modüle uygulanması gereken bir koddur. Fakat sizin yaptığınız şekilde de kullanılabilir.

Modül için aşağıdaki işlemleri yapın.

ALT+F11 tuşlarına basıp kod editörünü açın.
INSERT menüsünden MODULE seçeneğini seçin.
Sağ taraftaki beyaz pencereye kodu uygulayın.

Koddaki 3. satır olayını aşağıdaki bölümden ayarlayabilirsiniz...

Kod: 
For Each Veri In S1.Range("F[COLOR="Red"]3[/COLOR]:U" & S1.Cells(Rows.Count, 2).End(3).Row)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst