Bir hücredeki sayıya başka bir hücredeki sayıyı ekleme

[Ömer]

Hata düzeltildi.

2. sorunuzu anlamadım. Örnek ekleyerek açıklayınız.

İndir personel icmal Kopya

Dosyayı indir personel icmal Kopya

dosya.co

.

 

[catasoy3]

Hata düzeltildi.

2. sorunuzu anlamadım. Örnek ekleyerek açıklayınız.

İndir personel icmal Kopya

Dosyayı indir personel icmal Kopya

dosya.co

.

mesela aylar yerine oraya ürün yazsam diyelim ki veya her hangi bir kelime
adem monitör
adem klavye gibi gibi

 

[Ömer]

Olabilir, kişiler sayfasında bu yazdığınız isimlere ait aylar yerine de sütun adları olacak sanırım. Bununla ilgili örnek eklerseniz düzenleyip eklerim.

 

[catasoy3]

Olabilir, kişiler sayfasında bu yazdığınız isimlere ait aylar yerine de sütun adları olacak sanırım. Bununla ilgili örnek eklerseniz düzenleyip eklerim.

bana öğretebilir misiniz makroları rica etsem daha sonradan başka sütünlar falan eklerim diye

 

[Ömer]

Kapsamlı bir şey istediniz, makrolarla ilgili bir alt yapınız var mı, varsa kodları inceleyip takıldığınız yeri sorarsanız daha doğru olacaktır.

 

[catasoy3]

Kapsamlı bir şey istediniz, makrolarla ilgili bir alt yapınız var mı, varsa kodları inceleyip takıldığınız yeri sorarsanız daha doğru olacaktır.

İndir ornek

Dosyayı indir ornek

dosya.co

Şöyle örnek bıraktım.

 

[Ömer]

Sütun isimlerinde "Flash Disk" - "Ekran Kartı" kartı gibi iki kelimeden oluşan veriler var.

Kodlar isim sütununa girdiğiniz son kelimeye göre arama yapıyordu, bu şekilde son kelime sütun adlarıyla uyuşmaz.

En başından isim ile açıklamayı ayrı sütunlara yazalım dememdeki sebeplerden biride buydu. Buna bir çözüm bulunabilir fakat veri düzenine göre farklı sorunlarda çıkabilir. O yüzden doğru veri işleme hesaplamalar için önemlidir.

Hala aynı görüşteyseniz kodları aşağıdakilerle değiştirerek deneyiniz.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)   
    
    Dim S1 As Worksheet, c As Range, sut As Byte, isim As String, k As Range
    Dim deg As String, deg1 As String, deg2 As String, s
        
    Set S1 = Sheets("Kişiler")
    
    If Target.Count > 1 Then Exit Sub
      
    If ActiveSheet.Name <> S1.Name Then
    
        If Intersect(Target, Range("B5:C" & Rows.Count)) Is Nothing Then Exit Sub
        If Target.Column = 3 And IsNumeric(Target) = False Or IsNumeric(Cells(Target.Row, "C")) = False Then Exit Sub
        If Cells(Target.Row, "B") = "" Then Exit Sub
        
        s = Split(Cells(Target.Row, "B"), " ")
        deg1 = s(UBound(s))
        deg2 = s(UBound(s) - 1) & " " & s(UBound(s))
  
        Set c = S1.Rows(3).Find(deg1, , xlValues, xlWhole)
        If Not c Is Nothing Then
            sut = c.Column
            deg = deg1
        Else
            Set k = S1.Rows(3).Find(deg2, , xlValues, xlWhole)
            If Not k Is Nothing Then
                sut = k.Column
                deg = deg2
            End If
        End If
        
        If sut = 0 Then
             MsgBox "İsmin Sonuna Yazılan Değer" & Chr(10) _
             & "Kişiler Sayfasında Bulunamadı", vbInformation
             Exit Sub
        End If
        
        isim = WorksheetFunction.Substitute(Cells(Target.Row, "B"), " " & deg, "")
          
        Application.EnableEvents = False
        Set c = S1.[A:A].Find(isim, , xlValues, xlWhole)
        If Not c Is Nothing Then
            S1.Cells(c.Row, sut) = S1.Cells(c.Row, sut) + Cells(Target.Row, "C")
        End If
        Application.EnableEvents = True
        
    End If
    
End Sub

.

 

[catasoy3]

Sütun isimlerinde "Flash Disk" - "Ekran Kartı" kartı gibi iki kelimeden oluşan veriler var.

Kodlar isim sütununa girdiğiniz son kelimeye göre arama yapıyordu, bu şekilde son kelime sütun adlarıyla uyuşmaz.

En başından isim ile açıklamayı ayrı sütunlara yazalım dememdeki sebeplerden biride buydu. Buna bir çözüm bulunabilir fakat veri düzenine göre farklı sorunlarda çıkabilir. O yüzden doğru veri işleme hesaplamalar için önemlidir.

Hala aynı görüşteyseniz kodları aşağıdakilerle değiştirerek deneyiniz.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)  
   
    Dim S1 As Worksheet, c As Range, sut As Byte, isim As String, k As Range
    Dim deg As String, deg1 As String, deg2 As String, s
       
    Set S1 = Sheets("Kişiler")
   
    If Target.Count > 1 Then Exit Sub
     
    If ActiveSheet.Name <> S1.Name Then
   
        If Intersect(Target, Range("B5:C" & Rows.Count)) Is Nothing Then Exit Sub
        If Target.Column = 3 And IsNumeric(Target) = False Or IsNumeric(Cells(Target.Row, "C")) = False Then Exit Sub
        If Cells(Target.Row, "B") = "" Then Exit Sub
       
        s = Split(Cells(Target.Row, "B"), " ")
        deg1 = s(UBound(s))
        deg2 = s(UBound(s) - 1) & " " & s(UBound(s))
 
        Set c = S1.Rows(3).Find(deg1, , xlValues, xlWhole)
        If Not c Is Nothing Then
            sut = c.Column
            deg = deg1
        Else
            Set k = S1.Rows(3).Find(deg2, , xlValues, xlWhole)
            If Not k Is Nothing Then
                sut = k.Column
                deg = deg2
            End If
        End If
       
        If sut = 0 Then
             MsgBox "İsmin Sonuna Yazılan Değer" & Chr(10) _
             & "Kişiler Sayfasında Bulunamadı", vbInformation
             Exit Sub
        End If
       
        isim = WorksheetFunction.Substitute(Cells(Target.Row, "B"), " " & deg, "")
         
        Application.EnableEvents = False
        Set c = S1.[A:A].Find(isim, , xlValues, xlWhole)
        If Not c Is Nothing Then
            S1.Cells(c.Row, sut) = S1.Cells(c.Row, sut) + Cells(Target.Row, "C")
        End If
        Application.EnableEvents = True
       
    End If
   
End Sub

.

peki birleşik bir şekilde yazsam olur mu

 

[Ömer]

Şuan verdiğim kodlar son boşluktan sonra olanı arıyor, bulamazsa son 2 kelimeye göre arıyor. Veri düzeni değişmeyecekse bu haliyle de işinizi görür.

 

[catasoy3]

Çok teşekkür ederim tam istediğim gibi olmuş kişiler sayfasında ne yazarsa onu buluyor ve orayı arttırıyor.
Mükemmelsiniz ilginiz için çok teşekkür ederim.

 

[Ömer]

Rica ederim, güle güle kullanın.

 

[catasoy3]

Rica ederim, güle güle kullanın.

peki son bir sorum olacak bu kodu google e tablolara yazabiliyor muyum

 

[Ömer]

Bu konuyla ilgili bilgim yok maalesef.

@Haluk Bey müsait olursa konuyu incelemesini rica edelim.