• DİKKAT

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

stok kod hareketlerini sorgulamak

P

power

Katılım
8 Aralık 2006
Mesajlar
218
Excel Vers. ve Dili
Excel 2002
Türkçe
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
 

Ekli dosyalar

üstatlarım,
sorum mu anlaşılmadı? yoksa yapmak istediğimi excelde yapmak mümkün değilmi?
 
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?
 
Merhaba
Aşağıdaki gibi deneyelim
Dosyanızda "ARŞİV" sayfası bulunmalıdır.

Downloads - TRtransfer

- Kitap12.zip - TRtransfer
trtransfer.net 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;
Kod: 
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
 
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
 

Ekli dosyalar

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.
 
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
Kod: 
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
 
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.
 
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
 
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.
 
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
 
İ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.
 
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
Kod: 
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
Kod: 
onceki = Empty
MsgBox "Kod güncellendi, Eski kod arşivlendi"
satırlarınıda aşağıdaki gibi
Kod: 
onceki = Empty
mj = IIf(Target.Range = "", "Silindi,", "Kod güncellendi,")
MsgBox mj & ", Eski kod arşivlendi"
 
Son düzenleme:
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.
 

Ekli dosyalar

  • adsız.JPG
    adsız.JPG
    155.1 KB · Görüntüleme: 10
Hocam çok teşekkürler son hali kusursuz.Bir hafta gibi deneme yaptıktan sonra gerçek kullanıma geçeceğim.
 
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?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst