• DİKKAT

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

Adisyon sıralamak

L

l0vesong

Katılım
23 Ağustos 2011
Mesajlar
17
Excel Vers. ve Dili
office 2003
Arkadaşlar veri sayfasında karmaşık düzen halinde girilen adisyon nolarını tablo sayfasında

xx01-xx50 ve xx51-xx00 düzeninde 50' şerli olarak gruplayıp

sıralı şekilde kendiliğinden yerleştirecek bir makro yazarmısınız.

Teşekkürler
 

Ekli dosyalar

l0vesong' Alıntı:
Arkadaşlar veri sayfasında karmaşık düzen halinde girilen adisyon nolarını tablo sayfasında

xx01-xx50 ve xx51-xx00 düzeninde 50' şerli olarak gruplayıp

sıralı şekilde kendiliğinden yerleştirecek bir makro yazarmısınız.

Teşekkürler
Genişletmek için tıkla ...
Eki inceleyin.
 

Ekli dosyalar

Husgvarna' Alıntı:
Eki inceleyin.
Genişletmek için tıkla ...

üstad eline sağlık çok güzel olmuş ama ufak bi sıkıntı var 50 şerli gruplamayı yanlış yapıyo mesela 1,2,3,4......48,50 yazıp 49u atlayıp yazmazsam tabloda 49 un yerine 50 yi 50 nin yerine ise 51 i alıyo halbuki her kuşulda 51 2. grubun başında başlaması gerekiyor. yani her 50 şerli grup ayrı sütunda olmalı
 
l0vesong' Alıntı:
üstad eline sağlık çok güzel olmuş ama ufak bi sıkıntı var 50 şerli gruplamayı yanlış yapıyo mesela 1,2,3,4......48,50 yazıp 49u atlayıp yazmazsam
Genişletmek için tıkla ...

Merhaba.

Daha açık anlatmalısınız.
Mesela sıralama nerede olmalı ?. "veri" sayfasındamı; "tablo" sayfasına aktarılıp veya tablolara alınması tamamlandıktan sonramı?
 
Son düzenleme:
Husgvarna' Alıntı:
Merhaba.

Daha açık anlatmalısınız.
Mesela sıralama nerede olmalı ?. "veri" sayfasındamı; "tablo" sayfasına aktarılıp veya tablolara alınması tamamlandıktan sonramı?
Genişletmek için tıkla ...

elimde 50 lik koçanlar halinde adisyonlar var bunların düzenli kullanıldığını saptamak için tablo oluşturacam.böylelikle kullanılmamış adisyonların yeri boş kalacak.

öncelikle sıralama tablo sayfasında olacak. ama dediğim gimi 50 şerli gruplar halinde. ama bu gruplar her sutunda sabit kalacak mesela 3 nolu adisyon veri sayfasında yazılmamışsa tablo sayfasında yeri boş klacak. yani yerine başka adisyon nosu gelmeyecek.
 
Merhaba,

Siz kullanılmayan adisyonları mı saptamak istiyorsunuz?

Eğer isteğiniz bu ise, neden tüm liste oluşturup olmayanların yeri boş tutulsun ki, doğrudan kullanılmayanları listelesin daha kolay olmaz mı?

Şimdiki isteğinizi karşılayan kodlar aşağıdadır, inceleyiniz.
İleride Koçan sayısı değişirse kod içindeki Kocan = 50 yi değiştiriniz.

Kod: 
Sub Adisyon_Sirala()
 
    Dim i       As Long, _
        SonSat  As Long, _
        j       As Integer, _
        k       As Integer, _
        min     As Integer, _
        Kol     As Integer, _
        Kocan   As Integer
 
    Dim wsv As Worksheet
    Dim wst As Worksheet
 
    Kocan = 50
    Set wst = Sheets("Tablo")
    Set wsv = Sheets("Veri")
 
    SonSat = wsv.Cells(Rows.Count, "A").End(3).Row
    If SonSat < 2 Then Exit Sub
 
    min = Application.WorksheetFunction.min(wsv.Range("A2:A" & SonSat))
    Kol = Int(min / Kocan) - 1
 
    Application.ScreenUpdating = False
    wst.Cells.ClearContents
 
    For i = 2 To SonSat
        k = Int(wsv.Cells(i, "A") / Kocan) - Kol
        j = wsv.Cells(i, "A") Mod Kocan
        If j = 0 Then j = Kocan
        wst.Cells(j, k) = wsv.Cells(i, "A")
    Next i
 
    Application.ScreenUpdating = True
 
    MsgBox "ADİSYONLAR SIRALANMIŞTIR....", vbInformation, "NECDET YEŞERTENER ---> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
 
End Sub
 

Ekli dosyalar

l0vesong' Alıntı:
elimde 50 lik koçanlar halinde adisyonlar var bunların düzenli kullanıldığını saptamak için tablo oluşturacam.böylelikle kullanılmamış adisyonların yeri boş kalacak.

öncelikle sıralama tablo sayfasında olacak. ama dediğim gimi 50 şerli gruplar halinde. ama bu gruplar her sutunda sabit kalacak mesela 3 nolu adisyon veri sayfasında yazılmamışsa tablo sayfasında yeri boş klacak. yani yerine başka adisyon nosu gelmeyecek.
Genişletmek için tıkla ...


Alternatif olarak eki inceleyin.
 

Ekli dosyalar

arkadaşlar harika olmuş çok teşekkürler ellerinize sağlık
 
ama sizden bi ricam olacak son olarak derdimi böyle parça parça anlattım ama toblayo son haline getiemek istiyorum yardımcı olursanız sevinirim.

veri sayfasında a sütunundaki her adisyon numarasının hangi tarihte kullanıldığını b sütunan girceğim. örn: 1145 nolu adisyon 5 şubat olarak veri sayfasına girilecek. böylelikle tablo sayfasında da her adisyon numarsının yanında veri sayfasına girilen tarihler olacak.

mümkünse şimdiden teşekkürler.
 
Son düzenleme:
l0vesong' Alıntı:
ama sizden bi ricam olacak son olarak derdimi böyle parça parça anlattım ama toblayo son haline getiemek istiyorum yardımcı olursanız sevinirim.

veri sayfasında a sütunundaki her adisyon numarasının hangi tarihte kullanıldığını b sütunan girceğim. örn: 1145 nolu adisyon 5 şubat olarak veri sayfasına girilecek. böylelikle tablo sayfasında da her adisyon numarsının yanında veri sayfasına girilen tarihler olacak.

mümkünse şimdiden teşekkürler.
Genişletmek için tıkla ...

Kodların alt kısmında bulunan ilgili bölüme aşağıdaki kırmızı kodu yazın.

Kod: 
Private Sub CommandButton1_Click()
 Sheets("tablo").Cells = ""
  Range("A2:b65000").Sort Key1:=Range("A2")
 b = 1
 c = 1
 Sheets("tablo").Select
 Sheets("tablo").Cells(c, b) = Cells(2, 1)
 Sheets("tablo").Cells(c, b + 1) = Cells(2, 2)
 For a = 2 To Cells(65000, 1).End(xlUp).Row - 1
 r = Cells(a, 1)
x:
 c = c + 1
 If Cells(a + 1, 1) <> "" Then
 If r + 1 <> Cells(a + 1, 1) Then
 Sheets("tablo").Cells(c, b) = ""
 r = r + 1
  If c = 50 Then
 b = b + 2
 c = 0
 End If
 GoTo x
 End If
 End If
 Sheets("tablo").Cells(c, b) = r + 1
 Sheets("tablo").Cells(c, b + 1) = Cells(a + 1, 2)
 If c = 50 Then
 b = b + 2
 c = 0
 End If
 Next
End Sub
 
Son düzenleme:
husgvarna' Alıntı:
kodların alt kısmında bulunan ilgili bölüme aşağıdaki kırmızı kodu yazın.

Kod: 
'.................................................
'.................................................
'.................................................
ıf c = 50 then
 b = b + 2
 c = 0
 end ıf
 goto x
 end ıf
 end ıf
 sheets("tablo").cells(c, b) = r + 1
 [color="red"]sheets("tablo").cells(c, b + 1) = cells(a, 2)[/color]
 ıf c = 50 then
 b = b + 2
 c = 0
 end ıf
 next
end sub
Genişletmek için tıkla ...

işte budur ama ufak bir sorun :))) a2 nin karşılığı 1 satır kaymış durumda ben düzelteye çalıştım ama olmadı anladığım kadarıyla sorun adisyon yazılı hücreden kaynaklanıyo zaten o hücre gereksiz silebilirim
 
Son düzenleme:
Merhaba,

Bende kodları düzelteyim.

Kod: 
Sub Adisyon_Sirala()
 
    Dim i       As Long, _
        SonSat  As Long, _
        j       As Integer, _
        k       As Integer, _
        min     As Integer, _
        Kol     As Integer, _
        Kocan   As Integer
    
    Dim wsv As Worksheet
    Dim wst As Worksheet
    
    Kocan = 50
    Set wst = Sheets("Tablo")
    Set wsv = Sheets("Veri")
    
    SonSat = wsv.Cells(Rows.Count, "A").End(3).Row
    If SonSat < 2 Then Exit Sub
    
    min = Application.WorksheetFunction.min(wsv.Range("A2:A" & SonSat))
    Kol = Int(min / Kocan) - 1
    
    Application.ScreenUpdating = False
    wst.Cells.ClearContents
    
    For i = 2 To SonSat
        k = Int(wsv.Cells(i, "A") / Kocan) - Kol
        k = k * 2 - 1
        j = wsv.Cells(i, "A") Mod Kocan
        If j = 0 Then j = Kocan
        wst.Cells(j, k) = wsv.Cells(i, "A")
        wst.Cells(j, k).Offset(0, 1) = wsv.Cells(i, "B")
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "ADİSYONLAR SIRALANMIŞTIR....", vbInformation, "NECDET YEŞERTENER ---> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub
 

Ekli dosyalar

Merhaba.
Son mesajımdaki kodlar değişti.
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst