Blok ta Ara

[şehiriçi]

Merhaba Arkadaşlar ,
Değerli üstadlarım yine karmaşık bir soruyla karşınızdayım ekli dosyamda izah etmeye çalıştım ,başlık vermekte de zorlandım . Başlık uygun değilse sitenin uzmanları tarafından değiştirilebilir. Bu soruya benzer bir konuyu sayın Korhan hocamın desteğiyle daha önce çözülmüştü, Umarım yine Korhan bey de bu soruya dahil olur,herkese iyi Akşamlar diliyorum vakit geç olduğu için gelebilecek cavaplarınıza yarın bakacağım inş.

 

[Necdet]

Merhaba,
Umarım doğru anlamışımdır.
Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Public Sub Makro1()

Dim arr As Variant
Dim rng As Range
Dim deg As Variant
Dim c   As Range
Dim i   As Long

i = Sayfa2.Cells(Rows.Count, "A").End(3).Row
'sayfa kodlarını aşağıdaki gibi kullanmadım, sayfa adına dikkat edin
'i = sheets("sehirici").Cells(Rows.Count, "A").End(3).Row

arr = Sayfa2.Range("A1:D" & i).Value

i = Sayfa1.Range("A1").End(xlToRight).Column
Set rng = Sayfa1.Range(Sayfa1.Cells(1, 1), Sayfa1.Cells(1, i))

For i = 2 To UBound(arr, 1)
    If Not arr(i, 3) = deg Then
        deg = arr(i, 3)
        Set c = rng.Find("BLOK_" & deg, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then arr(i, 4) = Sayfa1.Cells(2, c.Column)
    End If
Next i

Sayfa2.Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
MsgBox "İşlem Tamamlanmıştır...."

End Sub

 

[şehiriçi]

Merhaba ,
Necdet uzmanım , öncelikle cevabınız için çok teşekkürler .
Verdiğiniz kodu inceledim . İstediğime çok yaklaşmışsınız ancak eksik kalmış ,şöyleki dosyadan örnek vererek izah etmeye çalışayım.
Siz sehirici sayfası C sütunundaki blok no suna göre blok sayfasında ki bloku bulup blok başlangıcına da yazdırmışsınız ,evet istenen bu
Ancak mesela sehirici sayfası D46 ya B harfini blok sayfasındaki J2 sütunundan bulup yazdırmışsınız. fakat sehirici sayfası D57 ye gelince blok sayfasında J sütunundaki blok tekarlıyor yani başa dönüyor ,başa tekrar dönünce yine B yazması gerek.
Ben sehirici sayfası D57,D68,D79 ...devam ediyor bu 3 nü yeşil renkle işaretledim

 

[Necdet]

Merhaba,
Her blok değiştiğinde arama işini yapıp yazdırıyor.
Sizin C57 de blok değişmiyor ki değerlendirsin. C46 dan C100 e kadar Blok hep 10, dolayısıyla kod orada herhangi bir işlem yapmıyor, dolayısıyla da boş değer kalıyor. Sizin örnek te öyleydi. ya da ben öyle anladım.
Anladığım kadarıyla Tüm belediye evleri bulduğu satırda sanırım blok numarası yazılacak? Doğru mu anladım?

 

[Necdet]

Merhaba, deneyiniz.

Public Sub BlokAra()

Dim i   As Long
Dim c   As Range
Dim adr As String

With Sayfa2.Range("B:B")
    Set c = .Find("Belediye Evleri", LookIn:=xlValues)
    If Not c Is Nothing Then
        adr = c.Address
        Do
            i = c.Offset(0, 1)
            Sayfa2.Cells(c.Row, "D") = Sayfa1.Cells(2, i)
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> adr
    End If
End With

End Sub

 

[şehiriçi]

Merhaba ,
Necdet bey verdiğiniz kod da "Belediye Evleri " olduğu zaman doğru sonuç veriyor.
Ancak bizim blok lar gerçek te her zaman Belediye Evleri ile başlamıyor o yüzden bazı blokların ilk satırdaki leri değiştirdim
B13:B23 ü örnek vererek devam edersek,
ilk satırını Ucuzluk yaptım .D13 e yazılacak olan veri , blok sayfasındaki H2 deki "K" değeri dir.
Fikir vermek için şöyle bir kurgu yapabilirmisiniz.
sehirici sayfasındaki B13:B23 bloğunu ,blok sayfasındaki tüm bloklarda arasın ve doğal olarak ta H sütununda bulacaktır. Buluncada
H2 de ki değeri Sehirici sayfasındaki D 13 sütununa yazsın..(Not:Blok sayfasındaki her blok diğer bloklardan benzersiz bir şekildedir ,yani tıpa tıp aynı blok yok)

 

[Necdet]

Merhaba,
Ben mantıklı bir çözüm bulamadım. İlk verdiğiniz örnekler doğru gibi ama kod yazınca, böyle olmaz diyorsunuz.
Belirli bir ölçük yok.
İlk çözümde blok numaralırı değişince idi, onu yazdık uymadı,
sonraki açıklamanıza göre sadece belediye evlerinin karşılığındaki bloklar değerlendirildi, o da olmuyor dediniz.
ben geçerli bir kriter bulamadım, açıklamanızdan da bir sonuca ulaşamıyorum.

Belki bir arkadaş olayı anlar ve çözer diye umuyorum.