• DİKKAT

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

Excel içinde kelime aramak hakkında

Tekrar merhaba.

Önceki cevabımda yer alan kod'u tekrar güncelledim.
Sayfayı yenileyerek, yeni kod'u dosyanıza uygulayıp, kontrol ediniz.

X sütununda 9'uncu satırda veri olmamasına dikkat ediniz.

Önce çocuğumun işi, ardından da son günlerde sıklaşan ve
süresi de uzamaya başlayan elektrik kesintileri nedeniyle ancak bakabildim.
.
 
Sonucunu çok merak ettiğimden sık sık kontrol ediyordum, Sanırım Sn. yesimgurol'dan önce ben baktım, Sn. Ömer Hocam kodları öncekilerle tek tek irdeleyip inceleyeceğim, umarım bişeyler öğreniriz sayenizde, elinize sağlık.
 
tahsinanarat' Alıntı:
Sonucunu çok merak ettiğimden sık sık kontrol ediyordum, Sanırım Sn. yesimgurol'dan önce ben baktım, Sn. Ömer Hocam kodları öncekilerle tek tek irdeleyip inceleyeceğim, umarım bişeyler öğreniriz sayenizde, elinize sağlık.
Genişletmek için tıkla ...
Estağfurullah Tahsin Bey, elimizden geldiğince destek vermeye çalışıyoruz.

Ancak;
(verdiğim cevapların altında yer alan İMZA bölümünde de belirttiğim gibi)
konu sahibinin, verdiğim yeni cevabıma ilişkin geri bildirimi olmadığından 13 numaralı cevabımı sildim.
.
 
Ömer BARAN' Alıntı:
Estağfurullah Tahsin Bey, elimizden geldiğince destek vermeye çalışıyoruz.

Ancak;
(verdiğim cevapların altında yer alan İMZA bölümünde de belirttiğim gibi)
konu sahibinin, verdiğim yeni cevabıma ilişkin geri bildirimi olmadığından 13 numaralı cevabımı sildim.
.
Genişletmek için tıkla ...

Ömer Bey,inanın ben geçen akşam çocuğunuzla ilgileneceğinizi söylediğinizde hemen cevap yazmıştım ve inanın bütün gün cevap bekliyordum sizden:-((
Ama gerçekten kodları güncellediğinizi fark edemedim.Tamamen dikkatsizliğim:-( Çok özür dilerim ama ilgisiz olduğumdan değil bilakis bütün gün cevabınızı bekliyordum.Tahsin beyin önceki kodlar için yazdığını düşündüm o yüzden üstteki mesajınızı farkedememişim:-( ve inanın 3 haftam var ve önümde incelemem gereken 500 adet rapor var:-((
Mesajınızı okuyunca sizden cevap beklediğim için şok oldum inanın..
 
Son yapmış olduğunuz kod bu idi ;
Kod: 
Sub inceleme_rapor_tarihleri()
Set de = Sheets("DENEME"): Set wf = Application.WorksheetFunction
Q9ilk = wf.Match("İNCELEME", de.[B:B], 0)
Q9son = wf.Match("KARŞILAŞTIRMA", de.[B:B], 0)
Q10son = wf.Match("İNCELEME", de.Range("B" & Q9son + 1 & ":B65536"), 0) + Q9son

If de.[Q65536].End(3).Row > 9 Then de.Range(Cells(10, "Q"), Cells(de.[Q65536].End(3).Row, "R")).ClearContents
For Each alan In Range("A" & Q9son + 1 & ":N" & Q10son - 1)
    If IsDate(alan.Value) = True Then
    de.Cells(de.[Q65536].End(3).Row + 1, "Q") = CDate(alan.Value)
        For sat = de.[X1].End(4).Row To de.[X65536].End(3).Row
        If de.Cells(sat, "X") = "" Then GoTo 10
            For sut = 1 To 14
                If wf.CountIf(de.Range(Cells(alan.Row, sut), Cells(alan.Row, sut)), "*" & Cells(sat, "X") & "*") > 0 Then _
                                de.Cells(de.[Q65536].End(3).Row, "R") = de.Cells(sat, "X")
            Next
10:     Next: End If: Next: MsgBox "Tarihler sıralandı..."
End Sub
 
Peki yeni kod aşağıdaki şekilde idi.
.
Kod: 
[FONT="Arial Narrow"][B]Sub inceleme_rapor_tarihleri_X()[/B]
Set de = Sheets("DENEME"): Set wf = Application.WorksheetFunction
Application.Calculation = xlCalculationManual: Application.ScreenUpdating = False
Q9ilk = wf.Match("İNCELEME", de.[B:B], 0)
Q9son = de.Cells(wf.Match("KARŞILAŞTIRMA", de.[B:B], 0), 2).End(4).Row
Q10son = de.Cells(wf.Match("İNCELEME", de.Range("B" & Q9son + 1 & ":B65536"), 0) + Q9son, 2).End(3).Row
If de.[IV9].End(1).Column > 16 Then de.Range(Cells(9, "Q"), Cells(9, de.[IV9].End(1).Column)).ClearContents
For Each alan In Range("A" & Q9ilk & ":N" & Q9son - 1)
    If IsDate(alan.Value) = True Then
    de.Cells(9, de.[IV9].End(1).Column + 1) = CDate(alan.Value)
    de.Columns(de.[IV9].End(1).Column).AutoFit: End If: Next

If de.[Q65536].End(3).Row > 9 Then de.Range(Cells(10, "Q"), Cells(de.[Q65536].End(3).Row, "R")).ClearContents
For satır = Q9son To Q10son
For sütun = 1 To 14
    If IsDate(de.Cells(satır, sütun).Value) = True Then
        de.Cells(de.[Q65536].End(3).Row + 1, "Q") = CDate(de.Cells(satır, sütun).Value)
        For devam = satır + 1 To Q10son
            If IsNumeric(de.Cells(devam, 2)) Then Exit For
            k = k + 1: Next
            For Xsat = de.[X1].End(4).Row To de.[X65536].End(3).Row
                If de.Cells(Xsat, "X") = "" Then GoTo 20
                For d = satır To satır + k
For sut = 1 To 14
    If wf.CountIf(de.Range(Cells(d, sut), Cells(d, sut)), "*" & Cells(Xsat, "X") & "*") > 0 Then
        de.Cells(de.[Q65536].End(3).Row, "R") = de.Cells(Xsat, "X"): GoTo 10: End If: Next: Next
20: Next: End If: Next: k = 0
10: Next: Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True
MsgBox "Tarihler ve X sütunu karşılıkları listelendi..."
[B]End Sub[/B][/FONT]
 
İnanın nasıl teşekkür edeceğimi bilemiyorum.Çok ama çok teşekkür ederim.:bravo::mutlu::dua2::dua2:
Yapmış olduğunuz bu kodu içeren sayfa şablon olacak.Yeni bir konu açmıştım Word dosyalarını excel'e almak için,eğer ki word dosyalarımı da bu oluşturmuş olduğunuz şablon sayfasına göre aktarabilirsem, büyük bir zahmetten kurtulmuş olacağım sayenizde..
Çok çok teşekkür ederim, yardımınız ve ilginize...
 
Bu konu halledildi sanırım.
Diğer konunuza bakmıştım ancak malesef beni aşıyor sanırım.
Bu tür sorulara cevap verecek üye sayısı oldukça sınırlı diye düşünüyorum.
Yani biraz sabırlı olmanız gerekiyor gibi geldi bana.

İyi çalışmalar dilerim.
.
 
Evet Ömer Bey, sayenizde çözüme kavuştum.
Teşekkür ederim.
Siz öyle diyorsanız sanırım çözüm bulamayacağım:-( sağlık olsun..
Aslında yaptığım işlem kısaca şöyle, word belgesini açıyorum excel de yaptığınız kodun yaptığı gibi bakıyorum değerleri okuduğum o değerleri kendim aktarıyorum.
Yaptığınız kod tam istediğim gibi oldu. Düşüncem şu idi, word leri sizin bu yaptığınız kodları içeren sayfaya aktarmakti, böylece her dosyanın Excel de değer lendirilmesi sağlanacaktı..
Bu çevirme hakkında fikriniz varsa da bilmek isterim.
 
Son düzenleme:
Ömer BARAN' Alıntı:
Tahmin ediyorum.

Daha evvel benzer bir konuda (word'den excel'e) Sayın leumruk'tan aldığınız desteğe rastladım.
http://www.excel.web.tr/f50/wordden-excele-macro-ile-kopyalama-t45478.html
Belki oradan yürümek gerekiyor.
.
Genişletmek için tıkla ...

Ömer Bey, tekrar teşekkür ederim. O kadar arama yaptım ama bulamamistim detaylı bakamadim.Sanırım dosya örnekleri de indirilemiyor konu eski olduğundan fakat kodlar hâla yerinde:-)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst