For next döngüsünde sayaç değerinin küçük harf karşılığını hücreye yazma

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
               Sno03 = 0
               For n = 2 To shT.Cells(65536, 2).End(xlUp)
                  If shT.Cells(n, 3) = arrMm(1, j) And shT.Cells(n, 4) = arrMm(2, j) Then
                     x = x + 1: Sno03 = Sno03 + 1
    
                     With shR
                             .Range(.Cells(x, "B"), .Cells(x, "C")).MergeCells = True
                        With .Range(.Cells(x, "E"), .Cells(x, "G"))
                                                            .MergeCells = True
                                                            .ShrinkToFit = True
                                                            .HorizontalAlignment = xlLeft
                        End With
                             .Range(.Cells(x, "B"), .Cells(x, "M")).Select: Call AltKenarlik
                        
                        With .Cells(x, "D")
                                           .Value = Sno03        [color="red"] Küçük harfle a,b,c,ç, z,aa,ab,az,aaa,aab,aaaa,aaab ........... vs şeklinde yazmak istiyorum.)[/color]
                                           .Font.ColorIndex = 3
                                           .Font.Bold = True
                        End With
                             
                        ' shR.Cells(x, 6) = shT.Cells(n, 6)
                             .Cells(x, "A").Value = shT.Cells(n, 2)            'Masraf Merkezi
                             .Cells(x, "E").Value = shT.Cells(n, 4)            'Masraf Merkezi
                             .Cells(x, "H").Value = shT.Cells(n, 1)            'Maliyet Yılı
                             .Cells(x, "I").Value = "Bütçesinden"              'Açıklaması
                             .Cells(x, "N").Value = shT.Cells(n, "F")            'Maliyet Yılı
                        With .Cells(x, "J")
                                           .Value = shT.Cells(n, 5)           'Tutarı
                                           .NumberFormat = "#,##0.00"
                                            With .Font
                                                     .Name = "Courier New"
                                                     .ColorIndex = xlAutomatic
                                                     .Size = 9
                                                     .Bold = True
                                            End With
                        End With
                     End With
                  End If
               Next n
..........................
Döngüsünde sno3 değeri olarak dönen
1 için a
2 için b
3 için c
4 için ç
30 için aa

şeklinde yazmak mümkünmüdür.
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
arkadaşlar ben bir yere kadar geldim

Kod:
Function fMOD_harf(sayi As Integer, bln As Integer)
Arr_abc = Array("", "a", "b", "c", "ç", "d", "e", "f", "g", "ğ", "h", "ı", "i", "j", "k", "l", "m", "n", "o", "ö", "p", "r", "s", "ş", "y", "u", "ü", "v", "y", "z")
1    If sayi <= bln Then
        snc = sayi
        sharf = sharf & Arr_abc(snc)
     End If
     
2    If sayi > bln Then
        snc = sayi - bln
        sharf = sharf & Arr_abc(snc)
     End If

3    If snc > bln Then
        sayi = snc
        GoTo 1
     End If

4    fMOD_harf = sharf 'Arr_abc(snc)
End Function

Sub xx()
MsgBox fMOD_harf(31, 29)
End Sub
MsgBox fMOD_harf(sayi, 29) ifadesinde sayi de&#287;eri 1 den 29 a kadar olanlarda sonucu a........z aras&#305; d&#246;nd&#252;r&#252;yorum
ama
sayi = 30 oldu&#287;unda aa
sayi = 31 oldu&#287;unda ab
sayi = ?? oldu&#287;unda az
sayi = ??+1 oldu&#287;unda aaa

&#351;eklinde d&#246;necek &#351;ekilde nas&#305;l uyarlayabilirim.
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
...............

K&#305;smen sonuca ula&#351;t&#305;m. a&#351;a&#287;&#305;dad&#305;r.
 
Son düzenleme:
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
1 den 25259 a kadar ba&#351;ard&#305;m.... fazlas&#305; ile vaktim olunca u&#287;ra&#351;&#305;r&#305;m.


Kod:
Sub SayHarf_Test1()
MsgBox SayHarf(19373, True) & vbLf & "<<<Not:B&#252;y&#252;k Harf Opsiyoneldir>>>", , "Hsayar"
MsgBox SayHarf(19373) & vbLf & "<<<Not: Bir&#351;ey yaz&#305;lmazsa K&#252;&#231;&#252;k Harf Kabul edilir>>>", , "Hsayar"
MsgBox "<<<Not: En fazla 25259 say&#305;s&#305;n&#305; ""zzz"" olarak d&#246;nd&#252;r&#252;r>>>" & vbLf & _
"&#220;zerindeki say&#305;lar&#305; say&#305; olarak d&#246;nd&#252;r&#252;r" & vbLf & "25260>25260 gb", , "Hsayar"
End Sub
Sub SayHarf_Test2()
Dim syc As Double
Dim sayi As Double
sayi = 32768
MsgBox SayHarf(sayi, True), , "Hsayar-Excel.web.tr"
For syc = 29 To 870 Step 29
    MsgBox SayHarf(syc, True), , "Hsayar-Excel.web.tr"
Next syc
Son:
End Sub
Kod:
Function SayHarf(ByVal sayi As Double, Optional ByVal bHARF As Boolean = False)
'__________________________________________________________________________________________________
'<<||||||||||||||||||||          1 den 25259 a kadar olan say&#305;lar&#305;          ||||||||||||||||||||>>'
'<<||||||||||||||||||||              harf olarak d&#246;nd&#252;r&#252;r.                  ||||||||||||||||||||>>'
'<<||||||||||||||||||||-----------------------------------------------------||||||||||||||||||||>>'
'<<||||||||||||||||||||            hsayar - www.excel.web.tr                ||||||||||||||||||||>>'
'<<||||||||||||||||||||                 25/02/2008 - 20:40                  ||||||||||||||||||||>>'
'<<||||||||||||||||||||_____________________________________________________||||||||||||||||||||>>'
'=================================================================================================&#167;

Arr_abc = Array("z", "a", "b", "c", "&#231;", "d", "e", "f", "g", "&#287;", "h", "&#305;", "i", "j", "k", "l", _
                             "m", "n", "o", "&#246;", "p", "r", "s", "&#351;", "t", "u", "&#252;", "v", "y", "z")
bln = 29
Anlam = WorksheetFunction.Ceiling(sayi / bln, 1) 'TavanaYuvarla(Sayi, Anlam) fonsiyonu
sharf = ""
For syc = Anlam To 1 Step -1
     If Anlam > 0 And Anlam <= 1 Then
        sharf = Arr_abc(sayi): Exit For
     ElseIf Anlam > 1 And Anlam <= 30 Then
        sharf = Arr_abc((syc - 1) Mod bln) & Arr_abc((sayi Mod bln)): Exit For
    ElseIf Anlam > 30 And Anlam <= 871 Then
        tmp1 = WorksheetFunction.Ceiling(Anlam / (bln / 100), 0.001)
        tamkat = Int((tmp1) / 100) * 100
        fark = Int((tmp1 - tamkat) * 1000)
            If fark = 0 Or fark = 3449 Then
                ix = (Int(tamkat / 100) - 1)
            Else
                ix = (Int(tamkat / 100))
        End If
        sharf = Arr_abc(ix) & Arr_abc((syc - 1) Mod bln) & Arr_abc((sayi Mod bln)): Exit For
    Else
        sharf = sayi
    End If
Next syc

If bHARF = False Then
     SayHarf = sharf
Else
     SayHarf = UCase(Replace(Replace(sharf, "&#305;", "I"), "i", "&#304;"))
End If
End Function
 
Son düzenleme:
Üst