kırılımlı stok listesi

[abdullahss]

Merhaba,

Otomatik şekilde yanında ki yazıya göre numaralandırma yapmam gereken veriler var eğer veriye daha önce numara verilmişse aynı numarayı yazmasını verilmemişse diğerlerinden farklı şekilde yeni numara vermesini nasıl sağlarım ? şimdiden teşekkür ederim.

 

[Ömer BARAN]

Merhaba.

Yanlış anlamadıysam aşağıdaki kod işinizi görecektir.
Kod H:M sütun aralığını kullanıyor, bu sütunlara veri yazmayın.
.

[B]Sub KODLAMA_BRN()[/B]
Set wf = Application.WorksheetFunction: son = Cells(Rows.Count, 2).End(3).Row
Range("A2:A" & son).ClearContents: Range("H2:M" & son).ClearContents
Range("H2:M" & son).NumberFormat = "General": Range("A2:A" & son).NumberFormat = "@"
For sat = 2 To son
    For sut = 2 To 7
    If sut = 3 Then GoTo 10
    If Cells(sat, sut) = "st" Then GoTo 10
        If wf.CountIf(Range(Cells(1, sut), Cells(sat, sut)), Cells(sat, sut)) = 1 Then
            Cells(sat, sut + 6) = wf.Max(Range(Cells(1, sut + 6), Cells(sat, sut + 6))) + 1
        Else
            Cells(sat, sut + 6) = Cells(wf.Match(Cells(sat, sut), Range(Cells(1, sut), Cells(sat, sut)), 0), sut + 6)
        End If
10:  Next: Next
For sat = 2 To son
    For sut = 2 To 7
    If sut = 3 Then GoTo 20
        Cells(sat, sut + 6).NumberFormat = "@"
        If Cells(sat, sut + 6) = "" Then Cells(sat, sut + 6) = "00"
        If Cells(sat, sut + 6) < 10 And Cells(sat, sut + 6) <> "00" Then Cells(sat, sut + 6) = "0" & Cells(sat, sut + 6)
20:    Next
    Cells(sat, 1) = Cells(sat, 8) & Cells(sat, 10) & Cells(sat, 11) & Cells(sat, 12) & Cells(sat, 13)
Next: Range("H2:M" & son).ClearContents
MsgBox "İşlem tamamlandı..."
[B]End Sub[/B]

 

[abdullahss]

Ömer bey süper olmuş çok teşekkürler,Size de zahmet verdik.
Müsadenizle bir soru daha sormak istiyorum,A sütununa verilerin toplamını almak istiyorum stok kodu olarak ekte belirttim,böyle birşey mümkünmüdür.Şayet bu mümkünse çok daha verimli olacak.

 

[Ömer BARAN]

Önceki cevabımı güncelledim.
Kırmızı renklendirdiğim uyarıya dikkat edin.
Kod, yeni örnek belgenizin sütun yapısına göre yeniden düzenlendi.

Sayfayı yenileyerek, önceki cevabımı kontrol ediniz.
.

 

[abdullahss]

Ömer bey çok teşekkürler harika ötesi olmuş. H:M sütunları kılavuz olarak kullanılmış anladığım kadarıyla veri aldığımız sütunlar daha farklı olursa kodda nereleri değiştirmeliyim.dağınık veri olduğunu düşünelim
1. kırılım x sütunu
2. kırılım y sütunu
3. kırılım z sütunu
4. kırılım aa sütunu
5. kırılım d sütunu
6. kırılım ab sütunu
7. kırılım al sütunu
buna göre kılıavuz sütunlarda bb sütunu ancak olabilir oraya kadar veri var.
sizin kodlarla oynayarak sonuca ulaşırım diye düşünmüştüm ama beni bayağı bir aşan durum oluştu.

 

[Ömer BARAN]

Kırılım sayısı 5 idi ancak şimdi 7 diyorsunuz, veri kaynağı sütunlar da değişmiş.

Gerçek belgenizle aynı yapıda örnek belge eklerseniz daha iyi olur.(ilgili veriler olması gereken sütunlarda olacak şekilde)
st ise 00 olsun gibi istisnai durumlar varsa, ona ilişkin örnek veriler de olmasında yarar var.
Örnek belgede A sütununa olması gereken nihai sonucu da elle yazın.
.

 

[Ömer BARAN]

Tekrar merhaba.

3 numaralı cevap ekindeki örnek belgeye göre aşağıdaki kod işinizi görecektir.
Son cevabınızda ise sütunlar ve kriter sayısını artırmışsınız, yeni duruma göre örnek belge yükleyip, st'nin durumu gibi istisna olanları belirtirseniz, müsait olduğumda bakarım.
.

[B]Sub KODLAMA_BRN()[/B]
Set wf = Application.WorksheetFunction: son = Cells(Rows.Count, 2).End(3).Row
Range("A2:A" & son).ClearContents: Range("A2:A" & son).NumberFormat = "@"
For sat = 2 To son
    For sut = 2 To 7
    If sut = 3 Then GoTo 10
    If Cells(sat, sut) = "st" Then
        sayı = "00": GoTo 30: End If
        For s = 2 To sat
            If Cells(s, sut) = "st" Then
            sayı = "00": Exit For: End If
            If wf.CountIf(Range(Cells(2, sut), Cells(s, sut)), Cells(s, sut)) = 1 Then sayı = sayı + 1
        Next
        
        If sayı < 10 Then sayı = "0" & sayı
30:     Cells(sat, 1) = Cells(sat, 1) & sayı: sayı = 0
10: Next: Next
MsgBox "İşlem tamamlandı..."
[B]End Sub[/B]

 

[abdullahss]

Hocam kusura bakmayın bilgisayarım servise gitti yazamadım, excel dosyasını daha kolay olması için verileri yan yana aldım , kullandığım formu yüklüyorum BA sütununda ki verileri baz alarak işlem yapmam gerekiyor eğer veri yok ise 00 olarak yazmalı, toplamda 7 sütun ve kolay olması açısından sütun isimlerine numara verdim sıra numarasına göre verileri kullanacağım E-I sütununa ilk 5 sütunun sayısal değerlerini A sütununa 7 verinin toplamını almam gerekiyor .

 

[abdullahss]

kodda bu şekilde düzeltme yapınca oldu sanırım fakat bağzı numaralarda hata yapıyor gibi, eğer veri yok ise 00 olarak yazmalı, E-I sütununa ilk 5 sütunun sayısal değerlerini A sütununa 7 verinin toplamını almam gerekiyor .

Sub KODLAMA_BRN()
Set wf = Application.WorksheetFunction: son = Cells(Rows.Count, 3).End(3).Row
Range("A3:A" & son).ClearContents: Range("A3:A" & son).NumberFormat = "@"
For sat = 3 To son
    For sut = 53 To 59
    If Cells(sat, sut) = "st" Then
        sayı = "00": GoTo 30: End If
        For s = 3 To sat
            If Cells(s, sut) = "st" Then
            sayı = "00": Exit For: End If
            If wf.CountIf(Range(Cells(3, sut), Cells(s, sut)), Cells(s, sut)) = 1 Then sayı = sayı + 1
        Next
        
        If sayı < 10 Then sayı = "0" & sayı
30:     Cells(sat, 1) = Cells(sat, 1) & sayı: sayı = 0
10: Next: Next
MsgBox "İşlem tamamlandı..."
End Sub

 

[Ömer BARAN]

kodda bu şekilde düzeltme yapınca oldu sanırım fakat bağzı numaralarda hata yapıyor gibi, eğer veri yok ise 00 olarak yazmalı, E-I sütununa ilk 5 sütunun sayısal değerlerini A sütununa 7 verinin toplamını almam gerekiyor .

Sub KODLAMA_BRN()
Set wf = Application.WorksheetFunction: son = Cells(Rows.Count, 3).End(3).Row
Range("A3:A" & son).ClearContents: Range("A3:A" & son).NumberFormat = "@"
For sat = 3 To son
    For sut = 53 To 59
    If Cells(sat, sut) = "st" Then
        sayı = "00": GoTo 30: End If
        For s = 3 To sat
            If Cells(s, sut) = "st" [B][COLOR="Red"]Or Cells(s, sut)=""[/COLOR][/B] Then
            sayı = "00": Exit For: End If
            If wf.CountIf(Range(Cells(3, sut), Cells(s, sut)), Cells(s, sut)) = 1 Then sayı = sayı + 1
        Next
        
        If sayı < 10 Then sayı = "0" & sayı
30:     Cells(sat, 1) = Cells(sat, 1) & sayı: sayı = 0
10: Next: Next
MsgBox "İşlem tamamlandı..."
End Sub

Başka sorun yoksa, sizin mesajınızda eklediğim kırmızı kısmın işinizi görmesi gerekir.
Dosya üzerinde denemedim.