makro veri listeleme hatası

[nongeyikm]

Arkadaşlar,

Sn. Ömer Beyin hazırlamış olduğu aşağıdaki çalışmayı kullanmaktayım. Sanırım Ömer Bey'in işleri yoğunlu nedeniyle cevap verememekte.


Aşağıdaki makro ile dosya içindeki 31 sayfadan verileri alıp özet icmal sayfası oluşturmaktayım. sayfalardaki veri aralığım B12:AD86. Maalelef verileri alırken hatalı alıyor. makroya göz atabilirmisiniz ?

konunun ilk açıldığı link :

http://www.excel.web.tr/f14/listeleme-hk-t169672.html


Saygılarımla,



Sub ICMAL()
Set i = Sheets("İCMAL")
i.Range("B12:AD86").ClearContents
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For shf = 1 To Sheets.Count
If Sheets(shf).Name <> "İCMAL" Then _
Sheets(shf).Range("B12:E86").Copy i.Cells(i.Cells(Rows.Count, "YA").End(3).Row + 1, "YA")
Next
ison = i.Cells(Rows.Count, "YA").End(3).Row
i.Range("YA2:YD" & ison).Sort i.[YA1], xlAscending
i.Range("YA2:YD" & ison).RemoveDuplicates Columns:=1, Header:=xlNo
i.Range("YA2:YD" & i.Cells(Rows.Count, "YA").End(3).Row).Copy
i.[B12].PasteSpecial Paste:=xlPasteValues
i.Range("YA2:YD" & ison).Clear

For sat = 12 To i.[B11].End(xlDown).Row
For shf = 1 To ThisWorkbook.Worksheets.Count
If Sheets(shf).Name <> "İCMAL" Then
sson = Sheets(shf).[B11].End(xlDown).Row
If WorksheetFunction.CountIf(Sheets(shf).Range("B12:B" & sson), i.Cells(sat, "B")) > 0 Then _
ssat = WorksheetFunction.Match(i.Cells(sat, "B"), Sheets(shf).Range("B12:B" & sson), 0)
For sut = 6 To 27
If Sheets(shf).Cells(ssat + 11, sut) = "X" Then
say = say + 1
If say > 0 Then i.Cells(sat, sut) = i.Cells(sat, sut) + say: say = 0
ElseIf IsNumeric(Sheets(shf).Cells(ssat + 11, sut)) Then
deg = deg + Sheets(shf).Cells(ssat + 11, sut)
If deg > 0 Then i.Cells(sat, sut) = i.Cells(sat, sut) + deg: deg = 0
End If
Next
End If
Next
Next
i.[A9].Activate
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "Bence tamam", vbInformation, "--------------"
End Sub

 

[Necdet]

Merhaba,

Kodlar

Sheets(shf).Range("B12:E86").Copy i.Cells(i.Cells(Rows.Count, "YA").End(3).Row + 1, "YA")

aralığını kopyalıyor, bunu kendinize göre değiştirin. Siz açıklamanızda B12:AD86 aralığından söz ediyorsunuz.

Not : Kodların tamamına bakmadım.

 

[Ömer BARAN]

Merhaba.

Verdiğim kod'da herhangi bir sorun yok.

Sayın YEŞERTENER, belirttiğiniz kopyalama kod satırı, sayfalardaki SİCİl/AD SOYAD gibi temel bilgileri
İCMAL sayfası YA ve devamı sütunlara geçici olarak yazıp, burada tekrarsız ve sıralı liste oluşturuyor,
ardından da bu alandaki verileri B12:E86 aralığına aldıktan sonra asıl sayma toplama işlemine geçiyor.

Sayın nongeyikm
Açtığınız diğer konu sayfasına cevap yazdım, o cevapta belirttiğim şekilde,
hatalı sonuç verdiğini düşündüğünüz örnek belge yüklerseniz kontrol edilir elbette.
.

 

[nongeyikm]

Ömer Bey teşekkür ederim. Tekrar inceleyeceğim.

Saygılar,

 

[nongeyikm]

listeleme hk.

Ömer Bey merhaba,

Dosyayı ekledim.

İcmal sayfasında en altta kırmızı olarak fontladığım kişi 24.03.2018 tarihinden itibaren var olmasına rağmen "X" toplamını 17 olarak hesaplamakta. Bende mi hata var veya hatalı kayıt mı giriyorum çözemedim. Makronuzu tekrar gözden geçirebilirmisiniz veya nerede hata yaptığım konusunda bilgi verirmisiniz.

Saygılarımla,

 

[Ömer BARAN]

Tekrar merhaba.

► ALT+F11 tuşlarına basarak VBA ekranını görüntüleyin,
► Sol taraftan herhangi bir sayfanın adına fareyle çift tıklayın ve sağdaki kod blokunun tümünü kopyalayın,
► VBA ekranında üstteki MENÜ ÇUBUĞUndan INSERT=>MODULEyi seçin,
► Sağdaki boş alana, kopyaladığınız kodu yapıştırın,
► MODULE'ye yapıştırdığınız kodlarda, aşağıda belirttiğim değişiklikleri yapın,
-- aşağıdaki ilk kod satırının sonunda kırmızı renklendirdiğim _ (alt tire) işaretini silin,
-- son Next satırından yukarı doğru giderken rastlayacağınız ilk End If satırının altına bir tane daha End If satırı (mavi renklendirdiğim) ekleyin.

If WorksheetFunction.CountIf(Sheets(shf).Range("B12:B" & sson), i.Cells(sat, "B")) > 0 Then [B][COLOR="red"][SIZE="4"]_[/SIZE][/COLOR][/B]
'.................................
'.................................
                Next
            End If
[B][COLOR="Blue"][SIZE="4"]        End If
[/SIZE][/COLOR][/B]    Next
Next
i.[A9].Activate

► Sol taraftan tüm sayfa adlarına birer kez fareyle çift tıklayın ve her çift tıkladığınızda göreceğiniz sağdaki kodların tümünü silin (İCMAL isimli sayfa dahil).
► İCMAL isimli sayfaya bir adet Metin Kutusu/Şekil/Düğme ekleyin ve eklediğiniz nesneye fareyle sağ tıklayıp MAKRO ATAyı seçin,
► Açılacak küçük ekranda ICMAL isimli makronun adını fareyle seçerek, işlemi onaylayın.

SON OLARAK:
Artık sayfaya eklediğiniz bu nesneye fareyle tıkladığınızda kod istenilen işlemi yapacaktır.
Son olarak VBA ekranında kodların, sadece MODULE içerisinde olduğundan emin olun.

 

[nongeyikm]

Ömer Bey,

Çok özür dileyerek belirtmek isterim ki anlattıklarınızı uyguladım veya uygulamaya çalıştım fakat başarılı olamadım. Şayet uygun bir zamanınızda 5 dolu mesajdaki dosyaya bu anlattıklarınızı sizler uygulayabilirmisiniz.

Saygılar sunarım.

 

[Ömer BARAN]

.
Belge ekte.
.

 

[nongeyikm]

Ömer Bey merhaba,

İlgi alakanızdan dolayı çok çok teşekkür ederim. Sizlere zahmet verdim. Allah razı olsun.

Hayırlı günler dilerim.