stok kod hareketlerini sorgulamak

[power]

herkese iyi çalışmalar.
örnek dosyada,
cihazların kodlarındaki değişikliği tarihiyle birlikte kaydedip gerektiği zaman sorgulanabilmesi gerekiyor.exelde böyle bir imkanımız olabilirmi?
sorum tam olarak anlaşılmadıysa ekli dosyada ayrıntısı mevcut.
https://s4.dosya.tc/server8/apu7di/Kitap1.xls.html

 

[power]

üstatlarım,
sorum mu anlaşılmadı? yoksa yapmak istediğimi excelde yapmak mümkün değilmi?

 

[PLİNT]

Merhaba
Ek dosyayı inceleyiniz

Downloads - TRtransfer

- Kitap12.zip - TRtransfer

trtransfer.net

veya
https://www.dosyaupload.com/nK9S

 

[power]

hocam teşekkürler,
verdiğiniz dosyayı inceledim.yapmak istediğimi pirensip olarak yapıyor.fakat kullanımı biraz zor.(alışkanlıklardan dolayı ve birden fazla kullanıcısı olduğu için)
userform kullanmadan sadece excel sayfasından bu kayıtları tutamazmıyız?

 

[PLİNT]

Merhaba
Aşağıdaki gibi deneyelim
Dosyanızda "ARŞİV" sayfası bulunmalıdır.

Downloads - TRtransfer

- Kitap12.zip - TRtransfer

trtransfer.net

(Sadece "stok kod" ları içindir "seri no" değişimi için (belirtmemişsiniz) işlem yapılmıyor)

"Stok kod" larının bulunduğu sayfanın kod penceresine;

Public onceki As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim s1 As Worksheet, s2 As Worksheet
Application.EnableEvents = True
Set s1 = Sheets("ARŞİV")
Application.EnableEvents = True
If Target.Column <> 4 Or Target.Row = 1 Or Trim(Target.Value) = "" Then Exit Sub
If onceki = Empty Then Exit Sub
i = s1.Cells(Rows.Count, "B").End(3).Row + 1
Set c = s1.Range("D1:D" & i).Find(Target.Value, , xlFormulas, xlWhole, xlByRows, xlNext, False, False)
If Not c Is Nothing Then
MsgBox "Aynı kodlu -" & s1.Cells(c.Row, "B").Value & "- ARŞİV sayfasında kayıtlı ancak yinede eklenecek"
End If
sor = MsgBox("Bu sayfada kod değiştirilecek", vbYesNo)
If sor = vbYes Then
s1.Range("B" & i & ":C" & i).Value = Range("B" & Target.Row & ":C" & Target.Row).Value
s1.Cells(i, "D") = onceki
s1.Cells(i, 1) = i - 1
s1.Cells(i, "E") = Date
onceki = Empty
MsgBox "Kod güncellendi, Eski kod arşivlendi"
Else
Application.EnableEvents = False
Target.Value = onceki
onceki = Empty
Application.EnableEvents = True
End If:
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 4 Or Target.Row = 1 Or Trim(Target.Value) = "" Then Exit Sub
onceki = Target.Value
End Sub

 

[power]

Hocam iyi geceler,
vermiş olduğunuz kod çok güzel çalışıyor.kendi formatıma göre elimden geldiğince düzenleme yaptım.sorunsuz çalışıyor görünüyor.bir hata varmı bakmanız mümkünmü?
Tarih hücresine yada bir sonraki hücreye saat-dakika-saniye eklemeye çalıştım yamamadım yapılabilirmi?
son olarak mükerrer kod girişini engellemek için kullandığım kod ile sizin verdiğiniz kodu birlikte çalıştıramadım.o koduda ekledim.anladığım kadarıyla bir iki düzenleme gerekiyor.şimdiden teşekkürler.
https://s2.dosya.tc/server12/rcvsdv/deneme.xls.html

 

[PLİNT]

 

Ek dosyada düzenleme yapmaya çalıştım, deneyelim
https://www.dosyaupload.com/jy9F

  

 

[power]

düzenleme yaptığınız dosyayı denedim hocam.
mükerrer kod kısmında sıkıntı görünüyor.şöyleki, kodları değiştirdikce arşiv kısmına sıkıntısızca arşivleme yapıyor.kodları değiştirmeye devam ediyorum mükerrer bir kod girişi yaptığım zaman bir sefere mahsuz "mükerrer kod var" uyarısı veriyor.bundan sonra mükerrer kod girişi yapsamda uyarı vermiyor aynı zamanda arşivleme işlemide çalışmıyor.taki exceli kapatıp açıncaya kadar.yeniden dosyayı açınca yine birkez mükerrer kod kıyaslaması yapıyor.mükerrer kod denk gelmesse arşivleme bölümü sıkıntısızca çalışıyor,mükerrer kod denk gelirse hiç bir kod çalışmıyor hocam.

 

[PLİNT]

Merhaba
"exit sub" ile
"Application.EnableEvents = False" kalıyor omalı sayfa kodlarının tamamını aşağıdakilerle değişelim; çoklu hücre seçimlerinde hata vermemesi içinde ek yapmaya çalıştım
https://www.dosyaupload.com/jyd0

Public onceki As String
'-------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim s1 As Worksheet, s2 As Worksheet
If Intersect(Target, Range("G2:G" & Rows.Count)) Is Nothing Then Exit Sub
If onceki = Empty Then Exit Sub
On Error GoTo 10
Application.EnableEvents = False
Set s1 = Sheets("ARŞİV")
If Target = "" Or UCase(Target) = "ANISIZ" Or UCase(Target) = "111877" Or UCase(Target) = "117878" Or UCase(Target) = "117879" Or UCase(Target) = "DEPO" Or UCase(Target) = "KULLANMIYOR" Or UCase(Target) = "SERİ YÜKLÜ" Or UCase(Target) = "YÜKLENMİYOR" Then Exit Sub
If Len(Target.Value) <> 5 Or IsNumeric(Target.Value) = False Then
Target.Value = onceki
onceki = Empty
MsgBox "Girilen kod sayısal ve beş haneli olmalıdır"
GoTo 10
End If
If WorksheetFunction.CountIf(Range("G:G"), Target) > 1 Then
        MsgBox Target & " KODU BAŞKA TELSİZDE YÜKLÜ!", vbCritical
        Target.Value = onceki
        onceki = Empty
       GoTo 10
        End If
i = s1.Cells(Rows.Count, "G").End(3).Row + 1
Set c = s1.Range("G1:G" & i).Find(Target.Value, , xlFormulas, xlWhole, xlByRows, xlNext, False, False)
If Not c Is Nothing Then _
MsgBox "Aynı kodlu : " & s1.Cells(c.Row, "B").Value & vbCrLf & "ARŞİV sayfasında kayıtlı ancak yinede eklenecek"
sor = MsgBox("Bu sayfada kod değiştirilecek" & vbCrLf & "Eski Kod  : " & onceki & vbCrLf & "Yeni Kod : " & Target.Value, vbYesNo)
If sor = vbYes Then
s1.Range("B" & i & ":F" & i).Value = Range("B" & Target.Row & ":F" & Target.Row).Value
s1.Range("H" & i).Value = Range("H" & Target.Row).Value
s1.Cells(i, "G") = onceki
s1.Cells(i, 1) = i - 1
s1.Cells(i, "I") = Now
onceki = Empty
MsgBox "Kod güncellendi, Eski kod arşivlendi"
Else
Target.Value = onceki
onceki = Empty
End If:
10:
If Err <> 0 Then MsgBox "Bir hata oluştu kontrol ediniz": Err = 0
Application.EnableEvents = True
End Sub
'-----------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim j As Range
If Selection.Cells.Count > 1 Then
For Each j In Selection.Cells
If j.Column = 7 Then
Cells(j.Row, j.Column - 1).Select
MsgBox "İçinde kod sütunu bulunan birden fazla seçim yapılamaz"
onceki = Empty
Exit For
End If
Next
Exit Sub
End If
If Target.Column <> 7 Or Target.Row = 1 Or Trim(Target.Value) = "" Then Exit Sub
onceki = Target.Value
End Sub

 

[power]

Hocam iyi çalışmalar,
dosyayı uzun uzun denedim.Tek bir sıkıntı kalmış.
Kod hücresinde herhangi bir kod yoksa yani hücre boş ise,buraya yeni girilen kod mükerrer kod olsa dahi uyarı vermiyor.Kullanmış olduğumuz dosyada kod kısmı boş olan satırlar mevcut.buraya ilk kod girişi yapılırken aynı kod daha önce girilmiş ise uyarı alabilmemiz lazım.mükerrer karşılaştırmayla ilgili kodu tek çalıştırdığımda anlatmaya çalıştığım sorun meydana gelmiyor.

 

[PLİNT]

Kodlardan şu satırı silip;

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s1 As Worksheet, s2 As Worksheet
If Intersect(Target, Range("G2:G" & Rows.Count)) Is Nothing Then Exit Sub
If onceki = Empty Then Exit Sub

Bunun yerine kodların ortalarında; şu bölüme yeşil satırı ekleyelim

If WorksheetFunction.CountIf(Range("G:G"), Target) > 1 Then
MsgBox Target & " KODU BAŞKA TELSİZDE YÜKLÜ!", vbCritical
Target.Value = onceki
onceki = Empty
GoTo 10
End If
If onceki = Empty Then GoTo 10
i = s1.Cells(Rows.Count, "G").End(3).Row + 1

 

[power]

hocam çok teşekkürler,
denemeye devam ediyorum şu ana kadar sıkıntı çıkmadı.
MsgBox "Bir hata oluştu kontrol ediniz" bu mesajı hiç almadım.bu mesajı hangi durumlarda alabilirim?
MsgBox "İçinde kod sütunu bulunan birden fazla seçim yapılamaz" bu mesajın anlamını anlayamadım hocam.

 

[PLİNT]

Kodların başında "on error goto 10" bulunuyor eğer kodlarda herhangi bir hata oluşursa, bildirim vermeden herşey normalmiş gibi bitirmesin
MsgBox "Bir hata oluştu kontrol ediniz" mesajını gördüğünüzde "on error goto 10" satırını silip kodların neresinde takılıyor görebilirsiniz

MsgBox "İçinde kod sütunu bulunan birden fazla seçim yapılamaz" ilede; mesela "g3:g6" aralığını seçtiniz "g3" (aktif hücre) 'e veri girdiniz
enter ile "g4:g6" ya kadar veri girilirse kodlar çalışmayacaktır, o bölümde bu durumu engeller

 

[power]

İyi Akşamlar,
kodları sürekli deniyorum bir eksikliği, aksaklığı varsa şimdiden ortaya çıksın diye.şimdiye kadar bir sıkıntı yok.Yanlız daha önce girilmiş bir kodu silmek istediğimde"Aynı Kodlu:Arşiv sayfasında kayıtlı ancak yinede eklenecek" mesajını alıyorum.Aslında silinen kodun arşive eklenmesi çok mantıklı.Fakat arşiv sayfasında kayıtlı şeklinde mesaj vermesi dikkatimi çekti.Oysaki sildiğim kod arşivde kayıtlı değil.Aslında silinerek arşive eklenen kod satırında bir fark olsa ayırt edebilmemiz için çok daha iyi olurdu.

 

[PLİNT]

i = s1.Cells(Rows.Count, "G").End(3).Row + 1
Set c = s1.Range("G1:G" & i - 1).Find(Target.Value, , xlFormulas, xlWhole, xlByRows, xlNext, False, False)

"i" eşitliğindendir alt satırına "-1" yazın

"Kod silinecek" mesajı için şu bölüm

If Not c Is Nothing Then _
MsgBox "Aynı kodlu : " & s1.Cells(c.Row, "B").Value & vbCrLf & "ARŞİV sayfasında kayıtlı ancak yinede eklenecek"
If Target.Value = "" Then
sor = MsgBox("Kod silinecek", vbYesNo)
Else
sor = MsgBox("Bu sayfada kod değiştirilecek" & vbCrLf & "Eski Kod  : " & onceki & vbCrLf & "Yeni Kod : " & Target.Value, vbYesNo)
End If
If sor = vbYes Then

"Kod güncellendi" yerine "silindi" yazdırmak isterseniz

onceki = Empty
MsgBox "Kod güncellendi, Eski kod arşivlendi"

satırlarınıda aşağıdaki gibi

onceki = Empty
mj = IIf(Target.Range = "", "Silindi,", "Kod güncellendi,")
MsgBox mj & ", Eski kod arşivlendi"

 

[power]

iyi geceler,
son değişiklikte resimdeki hatayı alıyorum hocam.
Ana listeden kod hücresinde herhangi bir kodda değişiklik yapılırsa eski kod, arşiv sayfasında arşivleniyor.Ayrıca,
Ana listeden kod hücresinden bir kod "delete" ile silinirse yine arşiv sayfasında arşivleniyor.
Ben aslında arşiv sayfasına baktığım zaman ordaki kod, değişiklik yapılarak mı gelmiş yoksa silinerekmi gelmiş bu ayırt etmek istiyorum.farklı renkte olabilir yada silinerek arşivlenen kayıt için ayrı bir hücreye silindi yazdırılabilir.dediğim gibi iki kayıt arasında fark olması benim istediğim.

 

[PLİNT]

Merhaba
Ek dosyada "j" sütununa "Silinerek Geldi" yazacak ve "G" sütununda renkli olacak, istemediğinizi silersiniz.
https://www.dosyaupload.com/bacr

 

[power]

Hocam çok teşekkürler son hali kusursuz.Bir hafta gibi deneme yaptıktan sonra gerçek kullanıma geçeceğim.

 

[power]

PLİNT hocam iyi çalışmalar.
17 nolu mesajınızda verdiğiniz kodları kullanıyorum problem yok fakat bir ihtiyaç hasıl oldu.
Arşiv isimli sayfaya hücrelerin silinmesine ve değiştirilmesine karşı koruma koymak istiyorum.sayfa koru kısmından korumayı aktif ettiğim zaman ana listede yapılan değişiklikler arşiv sayfasına gitmiyor.nasıl bir çözüm öneriniz olabilir?