sayıyı parçalama

[benarivoo]

arkadaşlar merhaba...
Ekteki dosyayla ilgili yardımlarınızı esirgemezsenis sevinirim.
Teşekkürler.. İyi Günler...

 

[Necdet]

Merhaba,

F5

=INT(B5/1000)
=TAMSAYI(B5/1000)

G5

=INT(B5-(F5*1000))
=TAMSAYI(B5-(F5*1000))

H5

=(B5-INT(B5))*100
=(B5-TAMSAYI(B5))*100

 

[Ali]

Necdet Bey, güzel bir mantık. Tebrik ederim.

 

[Necdet]

Teşekkür ederim Ali bey.

 

[halit3]

örnek dosya aşağıdaki mesajda

 

[benarivoo]

ilginize ve emeğinize çok teşekkür ederim..

Necdet bey yalnız ekteki örnekte verdiim gibi; 13.001,00 = 13 001 00 olmalı
13 1 0 değil
15.000,01 = 15 000 01 olmalı
15 0 1 değil
927,98 = 927 98 olmalı
0 927 98 değil



Bunun gibi yüzlerce rakamı bu şekilde ayrı sütunlara olduğu gibi girmek durumundayım.Bu da işyerinde beni zaman açısından büyük kayıplara uğratıyor.
Yardımlarınızı bekliyorum....Tekrar teşekkürler..

 

[Necdet]

Merhaba,

Bu soruyu bekledim.

F5

=METNEÇEVİR(TAMSAYI(B5/1000);"#")

G5

=METNEÇEVİR(EĞER(EHATALIYSA(TAMSAYI(B5-(F5*1000)));0;TAMSAYI(B5-(F5*1000)));"000")

H5

=METNEÇEVİR((B5-TAMSAYI(B5))*100;"00")

 

[benarivoo]

Yeni sorun...

Necdet Bey yeni formulasyonda basamaklar azaldıkça G5 sütununu;
Örnek:928,61 == 000 61 şeklinde parçalıyor...Şuanki tek sorun bu.. Emeğinize teşekkürler...

Halit3 kardeşim size de çok teşekkür ediyorum...Sizin çalışmanızdaki tek sorun;
Örnek:100,45 == 010 45 şeklinde parçalıyor..Sayenizde bu sorun da ortadan kalkarsa artık zaman kaybından kurtulurum..Teşekkürler...

 

[halit3]

Sub Makro1()
Columns("D:H").ClearContents
For n = 5 To WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("B5:B65000")) + 4
deg1 = Round(Worksheets(ActiveSheet.Name).Cells(n, 2).Value, 2)
deg2 = Len(deg1)
deg3 = Val(deg1)
kat = 0
say = 0
For i = 1 To deg2
yer = Mid(Worksheets(ActiveSheet.Name).Cells(n, 2).Value, deg2 - i + 1, i)
If Left(yer, 1) = "," Then
Worksheets(ActiveSheet.Name).Cells(n, 8).NumberFormat = "00"
Worksheets(ActiveSheet.Name).Cells(n, 8).Value = Right(yer, 2)
End If
If Worksheets(ActiveSheet.Name).Cells(n, 8).Value = "" Then
Worksheets(ActiveSheet.Name).Cells(n, 8).Value = "00"
Worksheets(ActiveSheet.Name).Cells(n, 8).NumberFormat = "00"
End If
Next i
yer1 = ""
For j = 1 To Len(deg3)
ser = Mid(deg3, Len(deg3) + 1 - j, 1)
If say = 3 Then
kat = kat + 1
say = 0
yer1 = ""
End If
say = say + 1
yer1 = ser & yer1
Worksheets(ActiveSheet.Name).Cells(n, 7 - kat).Value = yer1
If say = 1 Then
alan8 = "0"
ElseIf say = 2 Then
alan8 = "00"
ElseIf say = 3 Then
alan8 = "000"
End If
Worksheets(ActiveSheet.Name).Cells(n, 7 - kat).NumberFormat = alan8
Next j
Next n
End Sub

 

[benarivoo]

Çalışma Dosyası

Halit3 hiçbir sorun kalmamış.. Çok teşekkür ederim..Utanarak çalışma dosyamı ekliyorum..Orada günler itibariyle çalıştırırsan çok teşekkür ederim...Aklına sağlık diyorum..İyi çalışmalar

 

[mesudiye_052]

Selam;

D8 Hücresine

=EĞER(UZUNLUK(TAMSAYI(B5))>3;PARÇAAL(B5;1;UZUNLUK(TAMSAYI(B5))-3);"")

E8 Hücresine

=YERİNEKOY(TAMSAYI(B5);D8;"";1)

F8 Hücresine

=EĞER(YERİNEKOY(YERİNEKOY(B5;D8&E8;"");",";"")="";"00";YERİNEKOY(YERİNEKOY(B5;D8&E8;"");",";""))


yaz aşağıya doğru çoğalt

kolay gelsin

 

[halit3]

dosyanı düzenledim ancak birleştirilmiş hücrelerin var bunları çözsen iyi olur birde makrolar 66 satırlık yaptım kendin sayıyı arttıra bilirsin çünkü birleştirilmiş hücreler var ondan 66 satırlık yaptım

 

[benarivoo]

Halit3 süpersin be abe..

Hay Allah razı olsun senden... Valla çok süper oldu...Halit3 kardeşim Çok teşekkür ederim....Emeğine sağlık...
Mesudiye 052 kardeş sen de sağol ilgilendiğin ve emek verdiğin için...Çok teşekkür ederim hepinize...Allah a emanet olun...

 

[halit3]

hayırlı işler

 

[mesudiye_052]

Selam;

Alternatif başka bir yöntem

D8 Hücresine

=EĞER(UZUNLUK(TAMSAYI(B5))>3;PARÇAAL(B5;1;UZUNLUK( TAMSAYI(B5))-3);"")

E8 Hücresine

=YERİNEKOY(TAMSAYI(B5);D8;"";1)

F8 Hücresine

=PARÇAAL(LİRA(B5;2);UZUNLUK(LİRA(B5;2))-4;3)

yaz aşağıya doğru çoğalt

kolay gelsin