Birleştir Ortala Yapılmış Hücre İçerisinden Belli Bir Yer Değiştirme...

S

Selcuk1903

Katılım
7 Ekim 2019
Mesajlar
135
Excel Vers. ve Dili
Tr 2019
Tablo da bulunan kırmızı yazı birleştir ortala ile birleştirilmiştir. Elimde sürekli sayıları değişen öğrenci tablosu bulunmaktadır. Benim isteğim tabloda kaç personel var ise kırmızı dolgulu ile birleştirilen satırın sayısının otomatik değişmesidir. Örneğin tabloda 3 personel var ise /////BU LİSTE YALNIZ 3 (ÜÇ) PERSONELDEN İBARETTİR. ///// veya 5 personel var ise /////BU LİSTE YALNIZ 5 (BEŞ) PERSONELDEN İBARETTİR. /////



https://www.dosya.tc/server41/7w169o/Ornek.xlsx.html
 
Son düzenleme:
N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,371
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Formül :
Kod: 
="///// Bu Liste Yalnız " & MAK(DOLAYLI("A1:A" & SATIR()-1)) & " ( " & KemalYazTL(MAK(DOLAYLI("A1:A" & SATIR()-1));"B") & ") Personelden İbarettir. \\\\\"
Rakamı Yazı ile yazmak içinse aşağıdaki kodları bir modüle kopyalayınız.
Dosyayı da Makrolu olarak kaydetmelisiniz.

Makro ile uğraşmak istemezseniz, adetin yazı ile karşılğını başka bir sayfada açık açık BİR, İKİ ... gibi yazıp oradan da çekebilirsiniz.
Fazla bir kişi olacağını sanmıyorum.


Kod: 
If Tur = "b" Then Tur = "B"
If Tur = "y" Then Tur = "Y"
If Tur = "k" Then Tur = "K"

B = Array("", "", "bin", "milyon", "milyar", "trilyon")
Dim A(0 To 2, 0 To 9)
A(0, 0) = ""
A(0, 1) = "yüz"
A(0, 2) = "ikiyüz"
A(0, 3) = "üçyüz"
A(0, 4) = "dörtyüz"
A(0, 5) = "beşyüz"
A(0, 6) = "altıyüz"
A(0, 7) = "yediyüz"
A(0, 8) = "sekizyüz"
A(0, 9) = "dokuzyüz"
 
A(1, 0) = ""
A(1, 1) = "bir"
A(1, 2) = "iki"
A(1, 3) = "üç"
A(1, 4) = "dört"
A(1, 5) = "beş"
A(1, 6) = "altı"
A(1, 7) = "yedi"
A(1, 8) = "sekiz"
A(1, 9) = "dokuz"
 
A(2, 0) = ""
A(2, 1) = "on"
A(2, 2) = "yirmi"
A(2, 3) = "otuz"
A(2, 4) = "kırk"
A(2, 5) = "elli"
A(2, 6) = "altmış"
A(2, 7) = "yetmiş"
A(2, 8) = "seksen"
A(2, 9) = "doksan"
 
Kusurat = Format((Sayi - Int(Sayi)) * 100, "00")
Sayi = String(15 - Len(Trim(Int(Sayi))), "0") + Trim(Int(Sayi))
 
Yazi = ""
YaziK = ""

For i = 1 To Len(Sayi)
    If i Mod 3 = 1 Then
       k = k + 1
       If (Mid(Sayi, Len(Sayi) - i - 1, 3)) <> "000" Then Yazi = B(k) & Yazi
    End If
    Yazi = A(i Mod 3, Val(Mid(Sayi, Len(Sayi) + 1 - i, 1))) & Yazi
Next
If Left(Yazi, 6) = "birbin" Then Yazi = Replace(Yazi, "birbin", "bin")

If Yazi = "" Then Yazi = "Sıfır"

If Tur = "B" Then
    Yazi = UCase(Replace(Replace(Yazi, "i", "İ"), "ı", "I"))
ElseIf Tur = "Y" Then
    Yazi = Application.WorksheetFunction.Proper(Yazi)
End If


'If Kusurat > 0 Then yazi = yazi + A(2, Val(Left(Kusurat, 1))) + A(1, Val(Right(Kusurat, 1))) + " Kr"
If Kusurat > 0 Then YaziK = A(2, Val(Left(Kusurat, 1))) + A(1, Val(Right(Kusurat, 1)))

If Tur = "B" Then
    YaziK = UCase(Replace(Replace(YaziK, "i", "İ"), "ı", "I"))
ElseIf Tur = "Y" Then
    YaziK = Application.WorksheetFunction.Proper(YaziK)
End If

Yazi = Yazi ' & " TL"
If Kusurat > 0 Then Yazi = Yazi & " " & YaziK & " Kr"
KemalYazTL = Yazi

End Function
 
H

hasankardas

Altın Üye
Katılım
14 Ağustos 2006
Mesajlar
369
Excel Vers. ve Dili
Ofis 2021ProPlus TR 64 Bit
Altın Üyelik Bitiş Tarihi
18-01-2027
Makro ile uğğraşmak istemiyorsanız yardımcı hücre ile öğrenci sayısını rakam olarak yazıp kullanabilirsiniz..


s6.dosya.tc/server12/jzho27/Ornek.xlsx.html
 
S

Selcuk1903

Katılım
7 Ekim 2019
Mesajlar
135
Excel Vers. ve Dili
Tr 2019
Necdet' Alıntı:
Merhaba,

Formül :
Kod: 
="///// Bu Liste Yalnız " & MAK(DOLAYLI("A1:A" & SATIR()-1)) & " ( " & KemalYazTL(MAK(DOLAYLI("A1:A" & SATIR()-1));"B") & ") Personelden İbarettir. \\\\\"
Rakamı Yazı ile yazmak içinse aşağıdaki kodları bir modüle kopyalayınız.
Dosyayı da Makrolu olarak kaydetmelisiniz.

Makro ile uğraşmak istemezseniz, adetin yazı ile karşılğını başka bir sayfada açık açık BİR, İKİ ... gibi yazıp oradan da çekebilirsiniz.
Fazla bir kişi olacağını sanmıyorum.


Kod: 
If Tur = "b" Then Tur = "B"
If Tur = "y" Then Tur = "Y"
If Tur = "k" Then Tur = "K"

B = Array("", "", "bin", "milyon", "milyar", "trilyon")
Dim A(0 To 2, 0 To 9)
A(0, 0) = ""
A(0, 1) = "yüz"
A(0, 2) = "ikiyüz"
A(0, 3) = "üçyüz"
A(0, 4) = "dörtyüz"
A(0, 5) = "beşyüz"
A(0, 6) = "altıyüz"
A(0, 7) = "yediyüz"
A(0, 8) = "sekizyüz"
A(0, 9) = "dokuzyüz"

A(1, 0) = ""
A(1, 1) = "bir"
A(1, 2) = "iki"
A(1, 3) = "üç"
A(1, 4) = "dört"
A(1, 5) = "beş"
A(1, 6) = "altı"
A(1, 7) = "yedi"
A(1, 8) = "sekiz"
A(1, 9) = "dokuz"

A(2, 0) = ""
A(2, 1) = "on"
A(2, 2) = "yirmi"
A(2, 3) = "otuz"
A(2, 4) = "kırk"
A(2, 5) = "elli"
A(2, 6) = "altmış"
A(2, 7) = "yetmiş"
A(2, 8) = "seksen"
A(2, 9) = "doksan"

Kusurat = Format((Sayi - Int(Sayi)) * 100, "00")
Sayi = String(15 - Len(Trim(Int(Sayi))), "0") + Trim(Int(Sayi))

Yazi = ""
YaziK = ""

For i = 1 To Len(Sayi)
    If i Mod 3 = 1 Then
       k = k + 1
       If (Mid(Sayi, Len(Sayi) - i - 1, 3)) <> "000" Then Yazi = B(k) & Yazi
    End If
    Yazi = A(i Mod 3, Val(Mid(Sayi, Len(Sayi) + 1 - i, 1))) & Yazi
Next
If Left(Yazi, 6) = "birbin" Then Yazi = Replace(Yazi, "birbin", "bin")

If Yazi = "" Then Yazi = "Sıfır"

If Tur = "B" Then
    Yazi = UCase(Replace(Replace(Yazi, "i", "İ"), "ı", "I"))
ElseIf Tur = "Y" Then
    Yazi = Application.WorksheetFunction.Proper(Yazi)
End If


'If Kusurat > 0 Then yazi = yazi + A(2, Val(Left(Kusurat, 1))) + A(1, Val(Right(Kusurat, 1))) + " Kr"
If Kusurat > 0 Then YaziK = A(2, Val(Left(Kusurat, 1))) + A(1, Val(Right(Kusurat, 1)))

If Tur = "B" Then
    YaziK = UCase(Replace(Replace(YaziK, "i", "İ"), "ı", "I"))
ElseIf Tur = "Y" Then
    YaziK = Application.WorksheetFunction.Proper(YaziK)
End If

Yazi = Yazi ' & " TL"
If Kusurat > 0 Then Yazi = Yazi & " " & YaziK & " Kr"
KemalYazTL = Yazi

End Function
Genişletmek için tıkla ...



Teşekkür ederim... çok sağolun
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst