• DİKKAT

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

Çözüldü Listboxtan sayfaya kaydetmede sayı yerine metin kaydetme hatası

  • Konbuyu başlatan Konbuyu başlatan FERAZ
  • Başlangıç tarihi Başlangıç tarihi
FERAZ

FERAZ

Katılım
5 Kasım 2006
Mesajlar
603
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
Merhaba.
Gifte anlattığım gibi sayı yerine metin kaydediliyor.
Sayı olarak nasıl kaydedilebilinir?
Ondalık sayılarda problem oluyor.

https://dosya.co/524a7xkpnt0c/listbox_Metin.xlsm.html
https://www.dropbox.com/s/ghgabevcsxhc1av/listbox Metin.xlsm?dl=0



PHP: 
Private Sub CommandButton1_Click()
  
    son = Cells(Rows.Count, 1).End(3).Row
    
    With Me.ListBox1
        If .ListCount > 0 Then
            If MsgBox("Kaydedilsin mi?", vbQuestion + vbYesNo, "Kaydetme") = vbYes Then
                Range("A" & son + 1).Resize(.ListCount, 2).Value = .List
                MsgBox "Kaydedildi...", vbInformation, "Kaydetme"
                .Clear
                Exit Sub
            Else
                MsgBox "Kaydetme iptal edildi...", vbExclamation, "Kaydetme"
                Exit Sub
            End If
        Else
            MsgBox "Listbox Bos Olamaz...", vbExclamation, "Kaydetme"
            Exit Sub
        End If
    End With
  
End Sub

Private Sub CommandButton2_Click()
    With Me.ListBox1
       .AddItem Me.TextBox1.Text
       .List(.ListCount - 1, 1) = CDbl(Format(Me.TextBox2.Value, "#,##0.00"))
    End With
End Sub
 
Merhaba,
Listboxa ekleme için kullandığınız kodun formatında virgül yerine nokta kullanınız.
 
Ben şu şekilde denediğimde oluyor:
.List(.ListCount - 1, 1) = CDbl(Format(Me.TextBox2.Value, "#.##0.00"))
Genişletmek için tıkla ...
Bu şekilde yapmak virgül kullanmanızı etkilemez sadece listboxta nokta gözükür.
Alternatif olarak şöyle de yapabilirsiniz. CDbl(Format(Me.TextBox2.Value, "0.00"))
 
Her türlü denedim bende çalışmıyor.
Bilgisayar dilini Almanca ve Türkçe yaptım diğer bilgisayarayarı yani ondalık kısımlarınıda değiştirdim olmadı.
Sayfada metin biçiminde çıkmamalı sonuç listbox önemli değil.
 
Merhaba
Bölge ve Dil ayarlarından Ondalık ayarını virgül yaparken dosya açıksa değişmemiş olabilir
 
Merhaba.
Ben de fikrimi belirteyim istedim.
Listbox'taki verileri bir de aşağıdaki şekilde aktarmayı dener misiniz?
Rich (BB code): 
            If MsgBox("Kaydedilsin mi?", vbQuestion + vbYesNo, "Kaydetme") = vbYes Then
                For sat = 0 To .ListCount - 1
                    Cells(son + 1, 1) = .List(sat, 0)
                    Cells(son + 1, 2) = 1 * (.List(sat, 1))
                    son = son + 1
                Next
                MsgBox "Kaydedildi...", vbInformation, "Kaydetme"
                .Clear
                Exit Sub
 
Ömer hocam sağolun.
Bana toplu kaydetme kodu lazım.Sayfa kodlarında Target olayından dolayı kod yavaşlıyor orjinalde.Enable events olayını kullanırsamda bu kod bazen kodları durduruyor.Yani topluca sayfaya aktarılmalı.
 
Önce kayıt olayındaki METİN/SAYI sorununun düzelip düzelmediğini yazsaydınız keşke.
Herneyse; gerçek belgede ilgili sayfada Worksheet_Change kodu var anlaşılan ve A ve/veya B sütununda değişiklikle aktif hale geliyor.

O zaman şöyle bir çözümle, bu Change kodunun çalışması geçici olarak durdurulabilir.
Bunun için;
>> Belgeye VBA kısmına 1 adet Module ekleyip, bu modulde (başka kodlarınız varsa en üste) Public dur şeklinde tek satırlık bir kod ekleyin.
>>Ardından da UserForm'daki CommandButton1 kodu için önerdiğim For..Next döngüsünün,
-- hemen üstüne dur="BEKLE" şeklinde 1 satır ve
-- Next satırının hemen altına da dur="" şeklinde 1 satır,
-- Worksheet_Change kod blokunun Intersect... satırından önce de If dur = "BEKLE" Then Exit Sub şeklinde 1 satır
ekleyin.
Belirttiğim yöntemi dener misiniz?
 
Bende çalışan dosyayı ekliyorum, resimdeki dosyayı şuradan indirip dener misiniz?

BC7V9U.gif
 
Ömer BARAN' Alıntı:
Önce kayıt olayındaki METİN/SAYI sorununun düzelip düzelmediğini yazsaydınız keşke.
Herneyse; gerçek belgede ilgili sayfada Worksheet_Change kodu var anlaşılan ve A ve/veya B sütununda değişiklikle aktif hale geliyor.

O zaman şöyle bir çözümle, bu Change kodunun çalışması geçici olarak durdurulabilir.
Bunun için;
>> Belgeye VBA kısmına 1 adet Module ekleyip, bu modulde (başka kodlarınız varsa en üste) Public dur şeklinde tek satırlık bir kod ekleyin.
>>Ardından da UserForm'daki CommandButton1 kodu için önerdiğim For..Next döngüsünün,
-- hemen üstüne dur="BEKLE" şeklinde 1 satır ve
-- Next satırının hemen altına da dur="" şeklinde 1 satır,
-- Worksheet_Change kod blokunun Intersect... satırından önce de If dur = "BEKLE" Then Exit Sub şeklinde 1 satır
ekleyin.
Belirttiğim yöntemi dener misiniz?
Genişletmek için tıkla ...
Ömer hocam açıklamalar için sağolunuz.
Gerçek dosyada 9 sütun var :)
Ve selectionchange normal shange sendkeys koşullu biçimlendirme kodlar vs... varda var :) Sıra ekleme kodu mesela a8 sütununa veri girince a8:ı8..... yerlerini renklendirme var interior.colorindex ile.Dahada varda mobilden aklıma gelmedi :)
Yani hepsi birbirini tetikliyor.Dediğiniz yöntemi kullanmıştım kodda kısaltma olsun diye ve kafa karışmasın diye o tür kodları sildim foruma eklerken.Bana gerekli olan toplu kaydetme bunun için listbox kullanayım istedim yoksa hücrelere veri girmek daha kolay aslında.
 
Aşağıdaki kodu deneyebilirsiniz.

Kod: 
Private Sub CommandButton1_Click()
   
    son = Cells(Rows.Count, 1).End(3).Row
    
    With Me.ListBox1
        If .ListCount > 0 Then
            If MsgBox("Kaydedilsin mi?", vbQuestion + vbYesNo, "Kaydetme") = vbYes Then
                Range("A" & son + 1).Resize(.ListCount, 2).Value = .List
                son = Cells(Rows.Count, 2).End(3).Row
                Range("B2:B2" & son).Replace What:=".", Replacement:=",", LookAt:=xlPart
                Range("B2:B2" & son).TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
                Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
                MsgBox "Kaydedildi...", vbInformation, "Kaydetme"
                .Clear
                Exit Sub
            Else
                MsgBox "Kaydetme iptal edildi...", vbExclamation, "Kaydetme"
                Exit Sub
            End If
        Else
            MsgBox "Listbox Bos Olamaz...", vbExclamation, "Kaydetme"
            Exit Sub
        End If
    End With
   
End Sub

Private Sub CommandButton2_Click()
    With Me.ListBox1
       .AddItem Me.TextBox1.Text
       .List(.ListCount - 1, 1) = Me.TextBox2.Value
    End With
End Sub
 
Korhan Ayhan' Alıntı:
Aşağıdaki kodu deneyebilirsiniz.

Kod: 
Private Sub CommandButton1_Click()
  
    son = Cells(Rows.Count, 1).End(3).Row
   
    With Me.ListBox1
        If .ListCount > 0 Then
            If MsgBox("Kaydedilsin mi?", vbQuestion + vbYesNo, "Kaydetme") = vbYes Then
                Range("A" & son + 1).Resize(.ListCount, 2).Value = .List
                son = Cells(Rows.Count, 2).End(3).Row
                Range("B2:B2" & son).TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
                Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
                MsgBox "Kaydedildi...", vbInformation, "Kaydetme"
                .Clear
                Exit Sub
            Else
                MsgBox "Kaydetme iptal edildi...", vbExclamation, "Kaydetme"
                Exit Sub
            End If
        Else
            MsgBox "Listbox Bos Olamaz...", vbExclamation, "Kaydetme"
            Exit Sub
        End If
    End With
  
End Sub

Private Sub CommandButton2_Click()
    With Me.ListBox1
       .AddItem Me.TextBox1.Text
       .List(.ListCount - 1, 1) = Me.TextBox2.Value
    End With
End Sub
Genişletmek için tıkla ...

Korhan hocam kod ilk çalışmada hatasız tekrar kaydetmede virgül noktaya çevriliyor karışıyor tümden.
 
14 nolu mesajımdaki kodu güncelledim. Tekrar deneyiniz.
 
Evet çalıştı sağolun.

Range("B2:B2" & son) buradaki sağdaki 2 fazladan olmuş gibi :)
Kodunuzu zaman bulunca değiştirip deneyeceğim devamlı koddaki Destination:=Range("B2") yerden çalışmasın diye.Yani en son kaydetme satırına göre ayarlarım B2 yi kolay yaparım onu.
Başka yöntem ile olursa daha iyi olmazsa bu yöntemi kullanacağım.
 
Korhan hocam kodunuzu düzenledim.Bu sayede herzaman B2 den başlamayacak tüm veriler için.

DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Yukarıdaki yerlerin kısaltma ihtimali var mıdır?

Rich (BB code): 
Private Sub CommandButton1_Click()
  
    son1 = Cells(Rows.Count, 1).End(3).Row
    If son1 < 2 Then son1 = 1
    
    With Me.ListBox1
        If .ListCount > 0 Then
            If MsgBox("Kaydedilsin mi?", vbQuestion + vbYesNo, "Kaydetme") = vbYes Then
                Range("A" & son1 + 1).Resize(.ListCount, 2).Value = .List
                son2 = Cells(Rows.Count, 2).End(3).Row
                son1 = son1 + 1
                Range("B" & son1 & ":B" & son2).Replace What:=".", Replacement:=",", LookAt:=xlPart
                Range("B" & son1 & ":B" & son2).TextToColumns Destination:=Range("B" & son1), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
                Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
                
                MsgBox "Kaydedildi...", vbInformation, "Kaydetme"
                .Clear
                Exit Sub
            Else
                MsgBox "Kaydetme iptal edildi...", vbExclamation, "Kaydetme"
                Exit Sub
            End If
        Else
            MsgBox "Listbox Bos Olamaz...", vbExclamation, "Kaydetme"
            Exit Sub
        End If
    End With
  
End Sub

Private Sub CommandButton2_Click()
    With Me.ListBox1
       .AddItem Me.TextBox1.Text
       .List(.ListCount - 1, 1) = Me.TextBox2.Value
    End With
End Sub
 
Merhaba.
Sayın AYHAN'ın verdiği koddaki Space:=False gibi değeri False olanları silerek deneyin isterseniz.
.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst