Otomatik silme

[EmrExcel16]

Merhaba arkadaşlar ekli dosyamda otomatik silme işlemi yapmam gerekiyor
G2 hücresine bir değer girdiğimde a sutununda buna denk gelen en üsteki
değeri silmesi gerekiyor tabi g2 yide silip g6 hücresinden başlayarak sıralaması lazım .Ama a sutununda özellikle en üstekini silmesi gerekiyor ben bu şekilde bir kod buldum ama olmuyor karıştırıyor bana yardımcı olursanız sevinirim KONU ÇOK ACİL LÜTFEN

gson = [g65536].End(3).Row
ason = [a65536].End(3).Row
For i = gson To 2 Step -1
For a = 3 To ason
If Cells(i, "G") = Cells(a, "A") Then
msj = Cells(i, "G")
Range("A" & a & ":C" & a).Delete
Range("G" & i & ":H" & i).Delete
Else
End If

Next a
Next i

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Sil_Sırala()
 
    Dim c As Range, son As Long
    
    Application.ScreenUpdating = False
    
    son = Cells(Rows.Count, "G").End(xlUp).Row + 1
    
    Set c = [A:A].Find([G2], , xlValues, xlWhole)
    If Not c Is Nothing Then
        Range("A" & c.Row & ":C" & c.Row).Delete Shift:=xlUp
        Range("G" & son) = Range("G2")
        Range("H" & son) = Range("H2")
        Range("G2:H2").ClearContents
    End If
 
    Application.ScreenUpdating = True
 
End Sub

.

 

[EmrExcel16]

otomatik silme

Merhaba ömer bey elinize kolunuza sağlık çok güzel olmuş fakat şöyle bir sıkıntı var
g2 ye yazdığımız değer A da var ise siliyor ve istedğimiz yere ekliyor buraya kadar çok güzel
ama g2 ye yazdığım değer A da yok ise hiçbir işlem yapmıyor aslında olması gereken ama benim istediğim g2 yazdığım değer yok isede onuda g2 ve h2 den silsin ve g6 ve h6 dan sıralasın ve olmadığını göreyim
yardımlarınız için çok teşekkür ederim
Allah razı olsun

 

[Ömer]

Bu şekilde deneyin.

Sub Sil_Sırala()
 
    Dim c As Range, son As Long
    
    Application.ScreenUpdating = False
    
    son = Cells(Rows.Count, "G").End(xlUp).Row + 1
    
    Set c = [A:A].Find([G2], , xlValues, xlWhole)
    If Not c Is Nothing Then
        Range("A" & c.Row & ":C" & c.Row).Delete Shift:=xlUp
    Else
        MsgBox "Veriyi Bulamadım"
    End If
    
    Range("G" & son) = Range("G2")
    Range("H" & son) = Range("H2")
    Range("G2:H2").ClearContents
 
    Application.ScreenUpdating = True
 
End Sub

.

 

[EmrExcel16]

otomatik silme

Merhaba ömer bey hızınız için tekrar tekrar teşekkür etmek isterim sonunda dosyayı bitirdim sizlerden ve sizin gibi üstadlardan öğrendiğim kadarıyla bir macro yaptım sizden son bir ricam yapmaya çalıştığım bu macroda hızlarını nasıl artırabilirim hani olmuyosada sorun yok sadece bir fikir almak benim amacım yaptığınız herşeyden teşekkür ederim kolay gelsin

Sub YENİLE()
Application.ScreenUpdating = False
Range("H2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(C[-1],C[-7]:C[-6],2,0)),""RAFTA YOK"",VLOOKUP(C[-1],C[-7]:C[-6],2,0))"
Range("G2:H2").Value = Range("G2:H2").Value

Dim c As Range, son As Long
Application.ScreenUpdating = False
son = Cells(Rows.Count, "G").End(xlUp).Row + 1
Set c = [A:A].Find([G2], , xlValues, xlWhole)
If Not c Is Nothing Then
Range("A" & c.Row & ":C" & c.Row).Delete Shift:=xlUp
Else
End If
Range("G" & son) = Range("G2")
Range("H" & son) = Range("H2")
Range("G2:H2").ClearContents
Application.ScreenUpdating = True

End Sub


Sub GİRİŞ()
Range("C2").Select
ActiveCell.FormulaR1C1 = "=IF(RC1="""","""",NOW())"
Selection.AutoFill Destination:=Range("C2:C100"), Type:=xlFillDefault
Range("C2:C100").Value = Range("C2:C100").Value
Range("A2:C100").Copy
Sheets("Çıkış").Select
Range("A65536").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("G2").Select
Sheets("GİRİŞ").Select
Range("A2:C100").Select
Selection.ClearContents
Range("A2").Select

End Sub
Sub VERİ()
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]="""","""",COUNTIF(Çıkış!C[-1],VERİ!C[-1]))"
Selection.AutoFill Destination:=Range("B2:B100"), Type:=xlFillDefault
Range("L2:N5").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(IF(RC[-3]="""","""",VLOOKUP(RC[-3],C[-11]:C[-10],2,0))),""LİSTEDE YOK"",IF(RC[-3]="""","""",VLOOKUP(RC[-3],C[-11]:C[-10],2,0)))"
Range("O2:Q5").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(IF(RC[-6]="""","""",VLOOKUP(RC[-6],Çıkış!C[-14]:C[-13],2,0))),""RAFTA YOK"",IF(RC[-6]="""","""",VLOOKUP(RC[-6],Çıkış!C[-14]:C[-13],2,0)))"
Range("B2:B100").Value = Range("B2:B100").Value
Range("L2:N5").Value = Range("L2:N5").Value
Range("O2:Q5").Value = Range("O2:Q5").Value
Range("I2:K5").Select

End Sub

Sub SİL()
Range("G6:H6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("G2").Select
End Sub
Sub RAFKONROL()
Columns("A:C").Select
Selection.ClearContents
Sheets("Çıkış").Select
Columns("A:C").Select
Selection.Copy
Sheets("RAF KONTROL").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Columns("A:C").Select
Selection.EntireColumn.Hidden = False
Range("A1").Select

End Sub

Sub SIRALA()
Range("G5:H44").Select
Selection.Sort Key1:=Range("H5"), Order1:=xlAscending, Key2:=Range("G5") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
ActiveSheet.PageSetup.PrintArea = "$G$5:$H$44"
Range("G2").Select
End Sub

 

[Ömer]

Bu şekilde düzenleme yapılması zor.
Dosyanızı ekleyip eski kodları hesaba katmadan, yapılmasını gerekeni baştan detaylı açıklarsanız ona göre yeniden kod yazılabilir.

 

[EmrExcel16]

otomatik silme

Merhaba ömer bey ilğin için teşekkür ederim isteğiniz üzere kodları dikkate almadan dosyamı ekledim ve ne yapmak istediğimi dosya üzerinde ayrıntılı şekilde anlattım yapmak istedğim bunlardan ibaret zaten kodlarla hazırladığım dosyam ise bazen karıştırıyor ama sizin desteklerinizle bu işi çözeceğimize inanıyorum.dosyamı anlatmaya giriş-çıkış-veri olarak anlatmaya çalıştım inşallah yapmışımdır
Geciktiğim için çok çok özür dilerim ve sizin hızınınız içinde çok teşekkür ederim
yardımlarınız için ALLAH razı olsun.
Her şey için teşşekkür ederim

 

[Ömer]

Eki inceleyiniz. Sayfa üzerlerinde gerekli açıklamaları yaptım.

.

 

[EmrExcel16]

otomatik silme

dosyayı açamadım ama ömer bey dosyada bir sıkıntı olabilirmi ben mi yapamıyorum acaba

 

[Ömer]

Sıkıştırılmadan ekliyorum.

.

 

[EmrExcel16]

otomatik silme

Merhaba ömer bey dosya mükemmelin üstünde ne kadar teşekkür etsem az yanlız bazı sıkıntılarla karşılaştım bunları belirttim dosya üzerinde bunlara çözüm bulabilirmiyiz bilmiyorum ama yardımlarınızı rica ediyorum.
bunca yaptıklarınız ve bana zaman ayırdığınız için Allah razı olsun.

 

[EmrExcel16]

otomatik silme

Merhaba Ömer bey kusura bakmayın rahatsız ediyorum ama. Konu hakkında gelişme varmı acaba yoksa olması mümkün değilmi bana yardımcı olursanız sevinirim..Kolay gelsin..

 

[EmrExcel16]

otomatik silme

Ömer bey belki konu hakkında uğraşıyosunuzdur ama benimkisi sadece meraktan konu hakkında gelişme varmı eğer yok olmuyor ise başka bir çözüm bulmak zorunda olacağım bilğisini verirseniz sevinirim
Herşey için teşekkür ederim...

 

[Ömer]

ELMA A11 VE A12 DE İSE YERDEN ELMANIN YANINA A12 VEYA A11 YAZARSAM SIKINTI YOK AMA YANLIŞLIKLA​

ELMANIN YANINA A25 YAZARSAM YANİ ARMUTUN OLDUĞU RAFI YAZARSAM HATA VERSİN

Hangi ürünün hangi rafa gideceği nasıl anlaşılacak. Bu şekilde varsayımlarla kodu düzenlemek çok zordur.

Ürünlerin raf nolarını belirten bir data sayfanız var mı? Yoksa bu şekilde bir data oluşturmalısınızki kodlar buna göre işlesin.

 

[EmrExcel16]

otomatik silme

Tabi data sayfası yapabilirim ama benim sıkıntım şu sadece giriş yaparken veya yerden rafa parça kaldırırken Elma olan bir rafta yanına armut koymamak koymak istersem sistem izin vermesin yani 1 rafta 2 farklı malzeme olmasın sadece malzemeleri birbirine karıştırmak istemiyorum ama tek rafa istediğim kadar aynı malzemeden koyabilirm onda sıkıntı yok.
İlğiniz için teşekkür ederim
Allah razı olsun...

 

[Ömer]

Rafların tanımı gerekli. Dosyanıza data sayfasın eklerek bu tanımı yaparak tekrar ekleyiniz.

 

[EmrExcel16]

otomatik silme

Dosyayı güncelleyerek ekledim.

 

[Ömer]

Emre bey,

Benim istediğim data bu şekilde değildi. Sadece raf ve yer numalarını yazdınız. Oysa sizin sorunuz, ürünlerin doğru rafa kaldırılmasıyla ilgiliydi.

Benim istediğim data;

Ürün Adı ... Raf No

Şeklinde tüm ürünlerin tanımlamanız gerekir. Örnek dosyada en azından 10-15 satırlık bir tanımlama yaparsanız kodları yazarken deneme fırsatım olur.

 

[EmrExcel16]

otomatik silme

Ömer bey size tek kelimeyle Allah razı olsun diyorum bana yardımcı olduğunuz için.
Sorunuma gelince kendimi yanlış ifade ediyorum size karşı benim demek istediğim bana hanği rafa koymam gerektiğini söylemesine gerek yok bu biraz zahmetli olabilir.Benim amacım bir rafa farklı malzeme girmesin örneğin.
Elma a12
Elma a12
Elma a12 bu şekilde sıkıntı yok
Ama
Elma a12
Elma a12
muz a12 sorun burda muzun yanına a12 yazdığımda desinki bu rafa koyamazsın.
aslında ben bu parçayı yani muzu başka bir rafa koyacağım ama yanlışlıkla başka malzemenin rafını yazmayayım. onu enğellemek istiyorum.
Bunu giriş yaparkende dikkat edecek giriş yaparken adresleri yazdığımda veri sayfasına bakacak ve bu krıtere uyuyorsa giriş yapacak uymayanlarıda uyarı verecek.kısacası giriş yaparken ya boş bir rafa koyabileceğim yada daha önce giriş yaptığım malzemelerin yanına aksi taktirde girişe izin vermesin.
bunu veri sayfasında transver yaparkende uyğulaması gerekir.
herşey için tekrar tekrar teşekkür ederim.size çok minnattarım..

 

[Ömer]

Bu şekilde istememdeki amaç; örnek dosyanızda elma (A11 ve A12) 2 farklı rafa kalkmıştı.

Yanlış yazım olmuş sanırım. Her ürünün raf nosu tek ise sorun yok, o şekilde kod uygulanabilir.

Yalnız konuya bugün bakamayabilirim, yarın gün içinde bakar geri dönüş yaparım.