Hücrede F2 ve + işaretine basmadan rakamları toplanacak

[izcik]

Başlıkta eksik oldu: Hücrede F2 ve + işaretine basmadan, yazılı rakamları toplamaya hazır hale getirme..


Sayın uzmanlarım. Elimde kağıda yazılı ürün kodları ve karşılığında miktarları olan liste var.

Ben bu miktarları, örnekteki excel dosyama, ürün kodlarının yazılı olduğu B sütununun karşılığına, yani A sütununa yazıyorum.

Örnek: A1 sütununa 25 yazdım.
Daha sonra tekrar A1 sütununa 11 rakamını da ilave etmem gerekiyor. Bu ilaveyi yapabilmem için A1 sütununa F2 ye basıp, 25 rakamının yanına +11 şeklinde yazmam gerekiyor. Bu sistemle çalışıyorum.

Rakamların toplanmasını istemiyorum. tam olarak 25+11 şeklinde yazması gerekiyor. Çünkü daha sonra yazdığım rakamların kontrolünü yapıyorum ve toplama işlemlerini en son yapıyorum.

İstediğim şudur:

Örnek A1 sütununa 25 yazdım.
Aradan zaman geçti, tekrar A1 sütununa 11 rakamını ilave etmem gerekti.
Hiç F2 ye basmaya gerek kalmadan, direkt olarak A1 in üzerine 11 yazdığımda 25+11 olarak görünmesini sağlayacak makro yazılabilirmi?

Yani her seferinde F2 düğmesine basmaktan, ve + işaretine basmaktan kazandıracak..

Rakamlar otomatik toplanmayacak. Başında = işareti vs. gelmeyecek.

A1 e 25 yazacağım.
daha sonra A1 e 11 yazacağım
25+11 olarak görünecek.

Daha sonra yine A1 e (misal) 42 yazacağım
25+11+42 olarak görünecek A1 hücresi.
Hepsi bu..
Bunun kodu makrosu vs. oluşturulabilir mi?

Saygılarımla

(Otomatik toplanmasını istemememin sebebi: Rakamlar açık olarak görünecek ki elimdeki kağıtla kontrol yapabileyim. Daha sonra nasıl olsa kolayca toplarım.)

 

[uzmanamele]

merhaba

bu işinizi görür mü?

Dim eski As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
eski = [a1].Text
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Intersect(Target, Range("a1")) Is Nothing Then Exit Sub
[a1] = eski & "+" & Target.Text
Application.EnableEvents = True
End Sub

 

[Merhum İdris SERDAR]

Hem işlem sonucu ile hem formülü görseniz oluyor mu?

 

[izcik]

Uzmanamele uzmanım kodları altalta kod kısmına mı yazıyoruz? Yaptım olmadı da. Siz örnek dosyaya ekleyebilir misiniz kodları?

 

[izcik]

Hem işlem sonucu ile hem formülü görseniz oluyor mu?

Yurttaş uzmanım. İstediğim A1 e 25 yazacağım
o rakam duracak
daha sonra
yine A1 e 11 yazacağım. ve A1 hücresi
25+11 şeklinde görünecek.

Çünkü elimdeki kağıtla kontrollerini yapmam gerekiyor.

Galiba tam anlatamadım istediğimi. Belki de olmayacak bir şeydir.

Yani her seferinde F2 düğmesi ve + işaretine basmaktan kurtulmuş olacağım.

Sonucunu başka bir sütunda görmemin benim için bir mahsuru yok. Ama A sütununda 25+11 şeklinde görmeliyim ki;

manuel olarak doğru mu yazmışım yanlış mı yazmışım kontrol edebileyim.

(Elimdeki kağıtta 25 ayrı bir yerde yazıyor, 11 ayrı bir yerde yazıyor)

 

[izcik]

Uzmanamele uzmanım, verdiğiniz kodları nasıl kullanacağımı tarif eder misiniz?

 

[uzmanamele]

merhaba

ek dosya işinizi görür mü?

Public eskideger(100) As String
Sub üzerinetopla()
Set S1 = Sheets("sayfa1")
For i = 2 To S1.Range("a65536").End(3).Row
eskideger(i) = S1.Cells(i, 1)
Next
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call üzerinetopla
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Intersect(Target, Range("a1:a65536")) Is Nothing Then Exit Sub
satır = Target.Row
Cells(satır, 1) = eskideger(satır) & "+" & Target.Text
Application.EnableEvents = True
End Sub

 

[izcik]

:bravo:Uzmanamele uzmanım budur işte

Helal size !

 

[izcik]

Uzmanamele uzmanım kızmazsanız şunu soracağım; Mesala örnek2 de A2 yi silmek istediğim (del yaptığım) zaman silmiyor. Bu düzeltilebilir mi?

Eğer olmazsa bu haliyle de çalışırım.

Saygılar.

 

[uzmanamele]

merhaba

kodu bu şekilde değiştirerek dener misiniz

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Intersect(Target, Range("a1:a65536")) Is Nothing Then Exit Sub
satır = Target.Row
If Target = "" Then
eskideger(satır) = ""
GoTo 10
End If
Cells(satır, 1) = eskideger(satır) & "+" & Target.Text
10
Application.EnableEvents = True
End Sub

 

[izcik]

Uzmanamele uzmanım denedim ama toplama işlemini yapmadı. Ben örnek2 ile ilgili şöyle bir çözüm buldum.

Diyelimki A2 hücresine yanlış rakam yazdım ve silmem gerekiyor.

1- Kodların olduğu bölüme geliyorum

2- Worksheet in olduğu yerdeki tüm yazan kodları Ctrl+C ile kopyalıyorum. Sonra kodları siliyorum.

3- Silmek veya düzenlemek istediğim hücreyi düzenliyorum.

4- Sonra kodlar malum halen bellekte olduğu için Ctrl+V ile yapıştırıyorum.

Ve kaldığım yerden devam ediyorum.

Yukarıda "bu haliyle de çalışırım" dan kastettiğim de buydu değerli uzmanım.

Saygılar

 

[izcik]

Uzmanamele uzmanım oldu şimdi. Yani sonradan verdiğiniz kodları ilave etmemle oldu. Hem de naıl oldu biliyor musunuz?

Tam olarak istediğim gibi. Çok teşekkür ederim ilginiz ve yardımınız için Uzmanamele uzmanım.

İyi akşamlar

 

[izcik]

Bir ekleme;

son halinde silme yapacaksak hücreleri tek tek silmek gerekiyor. Eğer aynı anda birden fazla hücreyi silersek hem hata veriyor, hem de kodlar özelliğini kaybedip, pasif hale geliyor.

 

[izcik]

Evet defalarca denedim; hücreler silmek istendiğinde, tek tek silinirse hiç bir problem yok.

............

Şu excelle neler yapılamaz çok merak ediyorum doğrusu

 

[izcik]

Bir şey daha buldum. Sözkonusu dosyadaki rakamlar ister tek tek silinsin, hatta istenirse ,dosyanın içeriği tamamen silinsin, (bütün satır ve sütunlar);
dosya kaydedilip, kapatılıp tekrar açılırsa tamamen hatasız kullanıma hazır hale geliyor. Demekki dosyayı kapatıp açmak gerekiyormuş. Tıpkı bilgisayarı yeniden başlatmak gibi..

Excelde bir dosyayı veya kodları hatalı olduğunu düşünmeden önce, dosyayı kapatıp açmak lazım.

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak ekteki örnek dosyayı incelermisiniz. Benzer kodlar kullanılmıştır.

Kullanılan kod; (İlgili sayfanın kod bölümüne uygulayın.)

Option Explicit
Dim İlk_Veri As Variant
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target = Empty Then Exit Sub
    Application.EnableEvents = False
    If Target <> "" Then
    Target = İlk_Veri & "+" & Target.Text
    Else
    Target = Target.Text & "+"
    End If
Son: Application.EnableEvents = True
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    İlk_Veri = Target
End Sub

 

[kemalist]

selamlar,

alternatif olarak ekteki örnek dosyayı incelermisiniz. Benzer kodlar kullanılmıştır.

Kullanılan kod; (ilgili sayfanın kod bölümüne uygulayın.)

option explicit
dim ilk_veri as variant
 
private sub worksheet_change(byval target as range)
    on error goto son
    ıf ıntersect(target, [a:a]) ıs nothing then exit sub
    ıf target = empty then exit sub
    application.enableevents = false
    ıf target <> "" then
    target = ilk_veri & "+" & target.text
    else
    target = target.text & "+"
    end ıf
son: Application.enableevents = true
end sub
 
private sub worksheet_selectionchange(byval target as range)
    ilk_veri = target
end sub

formülle yapamazmıyız

 

[uzmanamele]

Selamlar,

Alternatif olarak ekteki örnek dosyayı incelermisiniz. Benzer kodlar kullanılmıştır.

Kullanılan kod; (İlgili sayfanın kod bölümüne uygulayın.)

Option Explicit
Dim İlk_Veri As Variant
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target = Empty Then Exit Sub
    Application.EnableEvents = False
    If Target <> "" Then
    Target = İlk_Veri & "+" & Target.Text
    Else
    Target = Target.Text & "+"
    End If
Son: Application.EnableEvents = True
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    İlk_Veri = Target
End Sub

merhaba

usta işi çözüm dedikleri bu olsa gerek.

 

[izcik]

Değerli Korhan Ayhan uzmanım. Evimde internet olmadığı için ancak bugün (pazartesi sabahı) görebildim çözümünüzü. Teşekkür etmekten başka bir şey söyleyemiyorum.

Uzmanamele uzmanım ve Korhan Ayhan uzmanım. Yardımlarınız ve, bilgi-tecrübelerinizden istifade ederek oluşturduğunuz excel dosyaları için teşekkür ederim. Tam istediğim şekildelerdir.

Sağolunuz.