• DİKKAT

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

Bir kolonda aynı olan satırı silip adet kısmına +1 eklemek

S

Sezerkaratas

Katılım
7 Ağustos 2019
Mesajlar
106
Excel Vers. ve Dili
İngilizce
Merhabalar ben bir sayfa üzerinde çalışıyorum . Sayfamda bir macro var . Macro f8 e değer girildiğinde altına bir satır ekliyor böylece liste uzayabiliyor . Ben buna ek olarak eğer f kolonunda aynı değer girilirse alt tarafta aynı olan satırı silsin ama eğer satır silerse j8 hücresine +1 eklesin istiyorum . J8 hücresi adet kolonu oluyor .

Şimdiden uğraşıcak arkadaşlara çok teşekür ediyorum
 
Örnek dosya paylaşın lütfen.
 
Dosyanızda herhangi bir makro yok, olmayan bir şeyin neresine ek yapalım:confused:
 
Dosya bulunamadı diyor.
 
Yapamadım maalesef.
 
Biraz acemice ama işinizi görür sanırım. Bu arada j sütununu rengini değiştiriniz.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

   If Range("f8") > 0 Then
     Rows("8:8").Select
  
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E9").Select
    Selection.AutoFill Destination:=Range("E8:E9"), Type:=xlFillDefault
    Range("E8:E9").Select
    Range("F8").Select
   
'---------------- buraya kadar sizin önceki kodunuz.. kayıt yapsın denildiği için normal kayıt işlemini yapıyor

 vx = Range("F9") ' f9 hücresine kayıt yapılan değerin değişkene atanması

 ' aşağıda; Kayıt f9 hücresine yapacak bu sebeple f10 ve sonraki hücrelerde aynı değerde hücre varmı yokmu diye bakabilmek için -bak- adı altında f10 - f11 - f12 diye artarak giden acemice bir değişken oluşturuluyor
kontrol = 9
10  kontrol = kontrol + 1 ' kontrol değişkeninin değerini  1 artır yani ilk başka 9 olan değeri 10 yap.. eğer tekrar bu satıra gelirse 11 yap gibi  
20 bak = "f" & kontrol   ' ilk olarak f10  diye yeni bir değer belirlenir 

 ' hücrenin içindeki değerin kontrol edilmesi  
30 If Range(bak) = "" Then GoTo 10000 'eğer  kontrol edilen hücre değeri boş ise daha önce aynı değerde kayıt yok demektir bu sebeple hiç bir işlem yapılmaması için 10000 nolu değere git ve işlem bitsin yoksa alt satıra geç

40 If vx = Range(bak) Then GoTo 2000 'eğer  kontrol edilen hücre değeri yeni girilen kayıt ile aynı ise 2000 numaralı satıra geç yoksa alt satıra geç

' işlem bu satıra geldiğine göre bakılan hücre değeri boş değil veya yeni kayıt değeri ile ayrı değil.. sonraki satırı kontrol için 10 numaralı satıra geri git
  
50 GoTo 10 


2000 ' işlem bu satıra yönlendirildiğine göre girilen kayıt ile aynı olan bir satır daha var  
Rows(kontrol).Delete Shift:=xlUp ' -kontrol- adı altındaki değişken bakılan satır numarasını vermektedir o satırı olduğu gibi siler 
Range("j9") = "+1" 'yeni kayıt f9 hücresine kayıt yapılıyor, siz j9 hücresine 1 eklesin dediğiniz için o satıra 1 ekliyor

10000

End If
End Sub


Aşağıdaki kod ise f8 hücresine aynı listede, aynı ürünün kaç defa tekrar edilerek girildiğini gösterir. Yani aynı girişi iki değil de 5 kere yapmışsanız 5 kere olduğunu gösterir.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

   If Range("f8") > 0 Then
     Rows("8:8").Select
   
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E9").Select
    Selection.AutoFill Destination:=Range("E8:E9"), Type:=xlFillDefault
    Range("E8:E9").Select
    Range("F8").Select
    vx = Range("F9")

kontrol = 9
10  kontrol = kontrol + 1
20 bak = "f" & kontrol
30 If Range(bak) = "" Then GoTo 10000
40 If vx = Range(bak) Then GoTo 2000
50 GoTo 10


2000
vv = (Range(("j") & kontrol))
Rows(kontrol).Delete Shift:=xlUp
vv = vv + 1
Range("j9") = (vv)

10000

End If
End Sub
 
Son düzenleme:
T
erenb' Alıntı:
Biraz acemice ama işinizi görür sanırım. Bu arada j sütununu rengini değiştiriniz.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

   If Range("f8") > 0 Then
     Rows("8:8").Select
  
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E9").Select
    Selection.AutoFill Destination:=Range("E8:E9"), Type:=xlFillDefault
    Range("E8:E9").Select
    Range("F8").Select
    vx = Range("F9")

kontrol = 9
10  kontrol = kontrol + 1
20 bak = "f" & kontrol
30 If Range(bak) = "" Then GoTo 10000
40 If vx = Range(bak) Then GoTo 2000
50 GoTo 10


2000
Rows(kontrol).Delete Shift:=xlUp
Range("j9") = "+1"

10000

End If
End Sub


Aşağıdaki kod ise f8 hücresine aynı listede, aynı ürünün kaç defa tekrar edilerek girildiğini gösterir. Yani aynı girişi iki değil de 5 kere yapmışsanız 5 kere olduğunu gösterir.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

   If Range("f8") > 0 Then
     Rows("8:8").Select
   
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E9").Select
    Selection.AutoFill Destination:=Range("E8:E9"), Type:=xlFillDefault
    Range("E8:E9").Select
    Range("F8").Select
    vx = Range("F9")

kontrol = 9
10  kontrol = kontrol + 1
20 bak = "f" & kontrol
30 If Range(bak) = "" Then GoTo 10000
40 If vx = Range(bak) Then GoTo 2000
50 GoTo 10


2000
vv = (Range(("j") & kontrol))
Rows(kontrol).Delete Shift:=xlUp
vv = vv + 1
Range("j9") = (vv)

10000

End If
End Sub
Genişletmek için tıkla ...


Teşekür ederim bide açıklamasını yapabilir misin öğrenmem açısından
 
erenb' Alıntı:
Biraz acemice ama işinizi görür sanırım. Bu arada j sütununu rengini değiştiriniz.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

   If Range("f8") > 0 Then
     Rows("8:8").Select
  
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E9").Select
    Selection.AutoFill Destination:=Range("E8:E9"), Type:=xlFillDefault
    Range("E8:E9").Select
    Range("F8").Select
    vx = Range("F9")

kontrol = 9
10  kontrol = kontrol + 1
20 bak = "f" & kontrol
30 If Range(bak) = "" Then GoTo 10000
40 If vx = Range(bak) Then GoTo 2000
50 GoTo 10


2000
Rows(kontrol).Delete Shift:=xlUp
Range("j9") = "+1"

10000

End If
End Sub


Aşağıdaki kod ise f8 hücresine aynı listede, aynı ürünün kaç defa tekrar edilerek girildiğini gösterir. Yani aynı girişi iki değil de 5 kere yapmışsanız 5 kere olduğunu gösterir.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

   If Range("f8") > 0 Then
     Rows("8:8").Select
   
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E9").Select
    Selection.AutoFill Destination:=Range("E8:E9"), Type:=xlFillDefault
    Range("E8:E9").Select
    Range("F8").Select
    vx = Range("F9")

kontrol = 9
10  kontrol = kontrol + 1
20 bak = "f" & kontrol
30 If Range(bak) = "" Then GoTo 10000
40 If vx = Range(bak) Then GoTo 2000
50 GoTo 10


2000
vv = (Range(("j") & kontrol))
Rows(kontrol).Delete Shift:=xlUp
vv = vv + 1
Range("j9") = (vv)

10000

End If
End Sub
Genişletmek için tıkla ...


BİR SORU DAHA SORMAK İSTİYORUM PEKİ BEN BU SAYFAYA STOK SAYFASINDAN ÜRÜN İSMİ ÜRÜN FİYATINI NASIL ÇEKEBİLİRİM AYNI MACROYLA
 
Dediğim gibi acemi kodlarıdır ve daha kısa yazabilir. Açıklamalar her bir satırın yanında yazılmıştır.
Örnek dosya https://s2.dosya.tc/server10/v9aky7/Yeni_Microsoft_Excel_Calisma_Sayfasi.xlsm.html


sayfa1 (mevcut sayfanız) ve stok isimli iki sayfanız olduğu varsayılmıştır.
stok sayfası a1= kod, b1= isim, c1= fiyat başlıkları, aşağıya doğru ise sırasıyla veriler bulunduğu varsayılmıştır.




Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

   If Range("f8") > 0 Then
     Rows("8:8").Select
 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E9").Select
    Selection.AutoFill Destination:=Range("E8:E9"), Type:=xlFillDefault
    Range("E8:E9").Select
    Range("F8").Select
    
    
  
'---------------- buraya kadar sizin önceki kodunuz.. kayıt yapsın denildiği için normal kayıt işlemini yapıyor

 vx = Range("F9") ' f9 hücresine kayıt yapılan değerin  kontrol ve diğer işlemlerin yapılması için değişkene atanması
 
 
 '--- stok sayfasında ürün ile ilgili bilgileri bulma
 s = 1 ' ilk hücre değerini 2 den başlatmak için s değişkenine 1 değeri verildi
100 s = s + 1
200 stkkdu = Worksheets("stok").Cells(s, 1) ' stok sayfasının 1 sütununu s satırından (ilk satır 2 den başlamak üzere) aşağıya doğru stkdu değeri ile aynı mı diye kontrol et

300 If stkkdu = "" Then GoTo 800 ' stok bulunamazsa işlem yapma ve uyarı mesajı vermesi için  satır 800 e git
400 If stkkdu = vx Then GoTo 600 ' stok değeri ile yeni kayıt eşleşti ise işlem yapmak için satır 600 e git
420 GoTo 100 ' stok sayfasındaki hücre boş değil ve girilen değerle uyuşmadığı için bir sonraki hücreyi kontrol etmesi için satır 100 e git

600 Worksheets("sayfa1").Range("g9") = Worksheets("stok").Cells(s, 2)
650 Worksheets("sayfa1").Range("I9") = Worksheets("stok").Cells(s, 3)
'c = Range(da)
700 GoTo 900


790 GoTo 900 ' değer eşleştiği ve yerleştirmeler yapıldığı için başka kayıt olup olmadığını kontrol etmek için satır 900 e git
800 yok = MsgBox("Stok adı bulunamadı ve işlem yapılmadı!", vbOKOnly) ' uyarı mesajı ver ve herhangi bir işlem yapmaması için satır 10000  git
Rows(9).Delete Shift:=xlUp '-kontrol- adı altındaki değişken bakılan satır numarasını vermektedir o satırı olduğu gibi siler

820 GoTo 10000


900  ' aşağıda; Kayıt f9 hücresine yapacak bu sebeple f10 ve sonraki hücrelerde aynı değerde hücre varmı yokmu diye bakabilmek için -bak- adı altında f10 - f11 - f12 diye artarak giden acemice bir değişken oluşturuluyor
kontrol = 9
1000  kontrol = kontrol + 1 ' kontrol değişkeninin değerini  1 artır yani ilk başka 9 olan değeri 10 yap.. eğer tekrar bu satıra gelirse 11 yap gibi
1020 bak = "f" & kontrol   ' ilk olarak f10  diye yeni bir değer belirlenir

 ' hücrenin içindeki değerin kontrol edilmesi
1030 If Range(bak) = "" Then GoTo 10000 'eğer  kontrol edilen hücre değeri boş ise daha önce aynı değerde kayıt yok demektir bu sebeple hiç bir işlem yapılmaması için 10000 nolu değere git ve işlem bitsin yoksa alt satıra geç

1040 If vx = Range(bak) Then GoTo 2000 'eğer  kontrol edilen hücre değeri yeni girilen kayıt ile aynı ise 2000 numaralı satıra geç yoksa alt satıra geç

' işlem bu satıra geldiğine göre bakılan hücre değeri boş değil veya yeni kayıt değeri ile ayrı değil.. sonraki satırı kontrol için 1000 numaralı satıra geri git
 
1050 GoTo 1000


2000 ' işlem bu satıra yönlendirildiğine göre girilen kayıt ile aynı olan bir satır daha var

Range("j9") = "+1"
vv = (Range(("j") & kontrol)) 'silmeden önce j sütununda veri olup olmadığını kontrol et
Rows(kontrol).Delete Shift:=xlUp '-kontrol- adı altındaki değişken bakılan satır numarasını vermektedir o satırı olduğu gibi siler
vv = vv + 1 ' j sütununda vv değişkenine atanan değeri alıp 1 artırır.. hiç değer yoksa 1 yapar ..  daha önce rakam varsa o değeri 1 artırır
Range("j9") = (vv) 'yeni kayıt f9 hücresine kayıt yapılıyor, siz j9 hücresine 1 eklesin dediğiniz için o satırı 1 artırarak ekliyor


10000

End If
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst