• DİKKAT

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

nokta, virgül sorunu

Katılım
5 Eylül 2007
Mesajlar
1,247
Excel Vers. ve Dili
ofis 2010
muhasebe programından excele veri aldığımda, binlik ve ondalık ayıraç virgül ve nokta olarak çıkıyor, benim işlem yapabilmem için makro ile virgülü silip, noktayı virgül yapmam gerekiyor, bu durumda excel sayı olarak algılıyor. Elle yapılıyor ama zaman alıyor. makro olursa diğer makroya monte ederek işlemi çabuklaştıracağım , teşekkürler
 

Ekli dosyalar

  • nokta_resim..jpg
    nokta_resim..jpg
    177.1 KB · Görüntüleme: 10
merhaba

ctrl h ile önce virgülü başka bir şey yapsanız mesela ";" ... sonra noktayı virgül yapsanız sonra ";" lü istediğiniz karakter yapsanız bunu yaparken de makro kaydetseniz kodları uretmis olursunuz sanırım....
 
Merhabalar. Dosyanızı almadan önce Dosya / Seçenekler / Gelişmiş Menüsünde Sistem ayırıcılarını kullan seçeneğini kaldırıp Muhasebe programınızdaki ondalık ve bin ayracına göre ayarlayın. Dosyanızı açın. Sonra tekrar aynı yerden seçeneği işaretleyin.

Eğer dosyanız düzgün olursa.

Bu kodları ondalık ve binlik ayracı olmasını istediğiniz gibi ayarlayıp, personal.xls dosyasına yapıştırıp. Hızlı araç çubuğuna düğme olarak ekleyin.

Dosyanızı açmadan önce ondalık değiştirme düğmesine açtıktan sonra da ondalık normal düğmesine basarsınız.

Umarım işinize yarar :)

Kod:
Sub ondalik_degistir()
    With Application
        .DecimalSeparator = ","
        .ThousandsSeparator = "."
        .UseSystemSeparators = False
    End With
End Sub

[CODE]Sub ondalik_normal()
    Application.UseSystemSeparators = True
End Sub
[/CODE]
 
denedim.

merhaba

ctrl h ile önce virgülü başka bir şey yapsanız mesela ";" ... sonra noktayı virgül yapsanız sonra ";" lü istediğiniz karakter yapsanız bunu yaparken de makro kaydetseniz kodları uretmis olursunuz sanırım....

denedim olmadı, tekrar tek tek sayıya çevir yapmam gerekiyor
 
arkadaslarin onerdigi diger secenekeleri denediniz mi ?
 
denendi

arkadaslarin onerdigi diger secenekeleri denediniz mi ?

başka bilgisayarlarda çalışmam gerektiği için , bölgesel ayarlar haricinde diğerlerini denedim, hala da adapte etmeye çalışıyorum. benim sorunum her zaman sabit iki sütundaki virgülleri silip, noktaları virgül yapmak, yanımda bulundurup ek ayarla uğraşmamam gerekiyor, dalgınlıkla farklı işlem yapıp yanlış olmasın diye. yani bu seçeneklerle henüz sonuca ulaşamadım. klasik yolla yapıyorum ama ondada dalgınlıkla nokta, virgül değişebiliyor işlemi sil baştan yapabiliyorum. örneklere teşekkürler,
 
muhasebe programından excele veri aldığımda, binlik ve ondalık ayıraç virgül ve nokta olarak çıkıyor, benim işlem yapabilmem için makro ile virgülü silip, noktayı virgül yapmam gerekiyor, bu durumda excel sayı olarak algılıyor. Elle yapılıyor ama zaman alıyor. makro olursa diğer makroya monte ederek işlemi çabuklaştıracağım , teşekkürler


Resim yerine örnek excel dosyası paylaşır mısınız?
 
Özel işlemleri kullanmak uygun değil ise, aşağıdaki kodu kullanabilir siniz.

Kod:
Sub onluk_virgul_ondalik_nokta()
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   Range("C2:D" & sonsatir).Select
   ondalikstr = Application.International(xlDecimalSeparator)
   For Each hucre In Selection
      txt = hucre.Text
      txt = Replace(txt, ",", "v")
      txt = Replace(txt, ".", ",")
      txt = Replace(txt, "v", ".")
      If ondalikstr = "," Then
         hucre.NumberFormat = "@"
         hucre.Value = CStr(txt)
      End If
      If ondalikstr = "." Then
         hucre.NumberFormat = "#,##0.00"
         hucre.Value = 0 + txt
      End If
   Next
End Sub
 
Alternatif kod

Kod:
Sub noktavirgulduzelt5()


son = Application.Calculation '-4105
'MsgBox Application.Calculation '-4135

With Application
.Calculation = xlManual '-4135
.ScreenUpdating = False
.EnableEvents = False
End With

Dim cell As Range

nokta = "."
virgul = ","

For Each cell In ActiveWindow.RangeSelection.Cells

deg3 = Split(cell.Value, nokta)
deg4 = Split(cell.Value, virgul)

hucre = cell.NumberFormat
If IsDate(cell.Value) = True Then GoTo atla2

cell.NumberFormat = "@"

If UBound(deg3) > 0 And UBound(deg4) > 0 Then

cell.Value = Trim(Replace(Replace(cell.Value, nokta, "[#]"), virgul, "[&]"))
End If

deg5 = Split(cell.Value, "[#]")
deg6 = Split(cell.Value, "[&]")

If UBound(deg5) > 0 And UBound(deg6) > 0 Then

cell.Value = Trim(Replace(cell.Value, "[#]", virgul))
GoTo atla
End If


atla2:
 


atla:
cell.NumberFormat = hucre
Next

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = son
End With


End Sub
 
eklentiyi yüklediğimde her markolu dosya açılışta hata veriyor
Open path & fileName For Output Access Write as hFile şeklinde

Eklenti Module3 içinde Üst menuye Özel İşlemler Menüsü eklemeye çalışıyor.
Bu klasöre yazmaya çalışıyor

path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"

Kodun içinden bu bölümü iptal edebilir siniz.
Yazma hakkı ile ilgili bir sorun olabilir.

ribbonXML = Replace(ribbonXML, """", "")

Open path & fileName For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile
 
Bu kod seçili alanı sayıya çeviriyor.
Kod:
Sub noktavirgulduzelt6()


son = Application.Calculation '-4105

With Application
.Calculation = xlManual '-4135
.ScreenUpdating = False
.EnableEvents = False
End With
Dim cell As Range
nokta = "."
virgul = ","
For Each cell In ActiveWindow.RangeSelection.Cells
cell.Value = Trim(cell.Value)

If Mid(Right(cell.Value, 3), 1, 1) = nokta Then
yer = Mid(cell.Value, 1, Len(cell.Value) - 3)
deg9 = Replace(yer, virgul, nokta) & virgul & Mid(Right(cell.Value, 3), 2, 3)
cell.Value = Replace(deg9, nokta, "") * 1
Else

If IsNumeric(cell.Value) = True And cell.Value > 0 Then
cell.Value = cell.Value * 1
End If
End If
Next

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = son
End With

End Sub
 
makro sorunsuz

Bu kod seçili alanı sayıya çeviriyor.
Kod:
Sub noktavirgulduzelt6()


son = Application.Calculation '-4105

With Application
.Calculation = xlManual '-4135
.ScreenUpdating = False
.EnableEvents = False
End With
Dim cell As Range
nokta = "."
virgul = ","
For Each cell In ActiveWindow.RangeSelection.Cells
cell.Value = Trim(cell.Value)

If Mid(Right(cell.Value, 3), 1, 1) = nokta Then
yer = Mid(cell.Value, 1, Len(cell.Value) - 3)
deg9 = Replace(yer, virgul, nokta) & virgul & Mid(Right(cell.Value, 3), 2, 3)
cell.Value = Replace(deg9, nokta, "") * 1
Else

If IsNumeric(cell.Value) = True And cell.Value > 0 Then
cell.Value = cell.Value * 1
End If
End If
Next

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = son
End With

End Sub

teşekkürler, bu işlemi sorunsuz halletti, kolay gelsin
 
Geri
Üst