- Katılım
- 12 Şubat 2009
- Mesajlar
- 451
- Excel Vers. ve Dili
- 2010 Türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
İyi geceler
Ekli dosya'da gerekli açıklamayı yapmaya çalıştım,tanımlı alanlarda bulunan verileri her birinden bir tane olacak şekilde sıralamam lazım ve iki kodu tek bir buton ile bordro sayfasından çalıştırmam gerekiyor,yardımcı olurmusunuz.
GENEL sayfasının A37 hücresinden başlayıp aşağıya doğru gidecek fakat A 36'ya GENEL Yazıcak
fakat buton BORDRO sayfasında olacak
Sub benzersiz_sirala()
Dim bd As Worksheet
Dim gn As Worksheet
Set gn = ThisWorkbook.Sheets("GENEL")
Set bd = ThisWorkbook.Sheets("BORDRO")
gn_son_sut = gn.Range("IV3").End(1).Column
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
bd.Range("IU:IV").ClearContents
gn.Range("A36:A65536").ClearContents
bd.Range("IU1") = "GENEL"
sat = 2
For sut = 5 To gn_son_sut Step 4
bd.Range("IU" & sat & ":IU" & sat + 30) = _
gn.Range(gn.Cells(3, sut), gn.Cells(33, sut)).Value
sat = sat + 31
Next
IU_sat = bd.Range("IU65536").End(3).Row
bd.Range("IU1:IU" & IU_sat).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=bd.Range("IV1"), Unique:=True
IV_son = bd.Range("IV65536").End(3).Row
gn.Range("A36:A" & 36 + IV_son - 1) = _
bd.Range(bd.Cells(1, "IV"), bd.Cells(IV_son, "IV")).Value
bd.Range("IU:IV").ClearContents
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sarı Butona basınca 2 ayrı kodun çalışmasını m istiyorsunuz?İki kodun birleştirilmesi konusunda yardımcı olabilirmisiniz
Sub kodlari_calistir()
Call [COLOR="Red"]buraya 1.kodlarınınz başlığını yazınız[/COLOR]
Call benzersiz_sirala
End Sub
Sayın : Ergün GÜLER Firma listesi içinde boş olan hücre varsa kayıt esnasında bunuda boş olarak geçiyor,Listelemede boşluğu göstermese kod üzerinde nasıl bir düzenleme yapmam lazım