18*49 luk tablodaki formülleri makrolaştırma..

[feridici_genc]

Hayırlı akşamlar..
1- Ekte bulunan dosyanın KM DAĞILIM sayfasında belirli tarihler arasında araçların kat ettikleri KM leri departmanlara paylaştırıyorum. Bu paylaştırma işlemini de Etopla ile yapıyorum.
Veriler sekmesine bir kaç kod yardımı ile gelen datalar var. Bu datalardan plaka ve departmana göre F sütununu etopla ile topluyorum.
Sıkıntım şurada: Etopla formülleri 50 000 satır alandakileri sorguluyor. Dolayısı ile buda çok yavaşlatıyor dosyayı. D8:V56 aralığındaki tüm formülleri makroya çevirebilir miyim?
Sanıyorum ki makro formülden daha hızlı ve kasmadan yapabilir bu işi.

2- Konu başlığından ayrı olarak bir ricada daha bulunmak istiyorum.
Veriler sekmesinde A2 den A50000 e kadar ki verilerin benzersiz olanlarını KM DAĞILIM sayfasında B8 den itibaren getirebilirmiyiz?

Alternatif dosya adresi: http://s6.dosya.tc/server5/x2sh29/Hesap-Kitap.rar.html

Teşekkürler...

 

[feridici_genc]

Her bir hücre için ayrı bir makro mu oluşturmak gerekiyor acaba?

 

[feridici_genc]

yardımlarınızı bekliyorum üstadlar.

 

[vardar07]

Daha kısa olabilir belki makro kaydet ile anca bu kadar.

 

[feridici_genc]

Üstadım iyi geceler.
Ben tüm formüllerin yerine tek bir kod ile hücrelere dağıtılır sanmıştım.
Tabi sizin bunu makro kaydet ile nasıl yaptığınızı anlayamadım ama gayet mükemmel.
Teşekkür ederim.
Ayrıca kullandığım formül etopla değil topla.çarpım mış. utandım
Bir sıkıntı fark ettim de..
Benzersiz plakalar alt alta sıralanmıyor. Yani; 3. bir benzersiz yazın en son plaka hanesine. O plaka örneğin 18. satırda ise diğer sayfada da 18. satırda kalıyor. diğer ikisinin altına gelmiyor.

 

[vardar07]

Module2 içindeki kodlar ile değiştirip deneyin.

Sub benzersiz()
Application.ScreenUpdating = False
Dim i As Long
With Sheets("VERİLER")
Sheets("KM DAĞILIM").Range("B2:B" & Sheets("KM DAĞILIM").Range("B51000").End(3).Row).ClearContents
a = 8
For i = 2 To .Cells(65536, "A").End(xlUp).Row
If WorksheetFunction.CountIf(.Range("A1:A" & i), .Cells(i, "A").Value) = 1 Then
 Sheets("KM DAĞILIM").Cells(a, "B").Value = .Cells(i, "A").Value
 a = a + 1
    End If
Next i
End With
Application.ScreenUpdating = True
End Sub

 

[feridici_genc]

Teşekkür ederim üstad. Hayırlı geceler.