• DİKKAT

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

Mod 9 için yardım

Katılım
11 Ağustos 2009
Mesajlar
44
Excel Vers. ve Dili
effice xp
mevcut bir excel çalışması var yardım alarak yapılan bir çalışma ve şimdi 6 haneli ve birde check digit var toplamda 7 haneli ama şimdi bu çalışmayı 7 haneli + check digit olarak değiştirmem gerekiyor yani toplam 8 haneli olaması için yadım dosya ekte
 

Ekli dosyalar

mod 9 için yardım

ekteki dosyada hazırlanmış bir formül var ama olay 6 hane + 1 check digitden 7hane +1 check digit olması için yardım istiyorum.
 

Ekli dosyalar

yeniden eklerle birlikte

ekte iki dosya olacak biri algoritma diğer bunla ilgili excel çalışması tek istediğim algoritma 6 hane 1 check digit 7 hane 1 check digit olmasını istiyorum yardım
 

Ekli dosyalar

  • mod 9.xls
    mod 9.xls
    59.5 KB · Görüntüleme: 2
  • algoritma.jpg
    algoritma.jpg
    97.5 KB · Görüntüleme: 3
Merhaba,
linkte işinize yarayacak bilgiler bulabilirsiniz. İyi çalışmalar.

Tıklayınız
 
ekte iki dosya olacak biri algoritma diğer bunla ilgili excel çalışması tek istediğim algoritma 6 hane 1 check digit 7 hane 1 check digit olmasını istiyorum yardım

merhaba ekteki kodları test edermisiniz. dosyanıza 7 haneli rakamları a hücresine yerleştirin ve kodu çalıştırın.


Kod:
Sub onalti()
    Dim Syl(1 To 7)
    For i = 1 To Range("A65536").End(3).Row
    
    For a = 1 To 7
    Syl(a) = Mid(Cells(i, "A").Value, a, 1) * 1
    Next a
    
    
    For b = 2 To 6 Step 2
    If Len(Syl(b) * 2) = 2 Then
    Syl(b) = Mid(Syl(b), 1, 1) + Mid(Syl(b), 2, 1)
    Else
    Syl(b) = Syl(b)
    End If
    Next b
    
    deger = (Syl(1) + Syl(2) + Syl(3) + Syl(4) + Syl(5) + Syl(6) + Syl(7)) * 1
    
    algrt = (Int((deger / 10) + 1) * 10) - deger
    
    If algrt = 10 Then
    algrt = 0
    End If
    
    Cells(i, "B").Value = "'" & Cells(i, "A").Value & algrt
    Next i
    End Sub
 
mod sistem ekli dosya

ekteki dosyalara bakarsanız durum anlaşılacaktır. excelde varolan çalışma 6 hane ve check digit var ben d hane ve check digit olmasını istiyorum
 

Ekli dosyalar

arkadaşım aynı konuda neden farklı farklı konu açıyorsunuz buna devam etsenize

İhsan bey,

Aynı konudan 2 tane var biliyorum ama diğeri sanırım altın uyelik altında bir kısıma taşınmış oraya mesaj yazamadığım için buraya yazmak zorunda kaldım..
 
hüseyin bey kod çalışıyo fakat sonucu hatalı veriyo algoritmayı tekrar göndercem hatalı hesap yapıyor...
 
ek dosay

hüseyin bey ekteki algoritmayı incelermisiniz..
 

Ekli dosyalar

  • algoritma.jpg
    algoritma.jpg
    97.5 KB · Görüntüleme: 4
hüseyin bey kod çalışıyo fakat sonucu hatalı veriyo algoritmayı tekrar göndercem hatalı hesap yapıyor...

Sorun 2 rakamları 2 ile çarpmadan işlem yapmışım işlemi düzelttim. ekli dosyayı incelermisiniz.


Kod:
Sub onalti()
    Dim Syl(1 To 7)
    For i = 1 To Range("A65536").End(3).Row
    
    For a = 1 To 7
    Syl(a) = Mid(Cells(i, "A").Value, a, 1) * 1
    Cells(i, a + 1).Value = Syl(a)
    Next a
    
    
    For b = 2 To 6 Step 2
    If Len(Syl(b) * 2) = 2 Then
    Syl(b) = Mid(Syl(b) * 2, 1, 1) * 1 + Mid(Syl(b) * 2, 2, 1) * 1
    Else
    Syl(b) = Syl(b) * 2
    End If
    Next b
    
    deger = (Syl(1) + Syl(2) + Syl(3) + Syl(4) + Syl(5) + Syl(6) + Syl(7)) * 1
    
    algrt = (Int((deger / 10) + 1) * 10) - deger
    
    If algrt = 10 Then
    algrt = 0
    End If

    Cells(i, "I").Value = algrt
    Cells(i, "J").Value = "'" & Cells(i, "A").Value & algrt
    Next i
    End Sub
 
Son düzenleme:
Geri
Üst