qbert yazdı:Merhabalar
Öncellikle geçmişte bulunduğunuz yardımlar için çok teşekkür ederim. Zamanla kullandığımız dosya deforma oldu ve pek sağlıklı çalışmamaya başladı. Bir de 20bin satırdan sonrasını uzatamadık. Kopukluk oldu, formül çalışmamaya başladı vs..
Sizlerden ricam bana 50-60 bin olsun farketmez, satır sayısı fazla olsun. Çünkü girilen veri sayısı bir hayli artmış durumda.
Şimdiden çok teşekkür ederiyorum.
Merhabalar...
Sorununuz ile ilgili bir şeyler hazırladım. 18000 satırda test ettim, sorunsuz çalıştı bende.
Eklediğim dosyada ki işlemler hakkında bahsedeyim;
Sayfada bulunan son satıra kadar çalışır, istediğinizde sayfayı istediğiniz kadar kopyalayıp kullanabilirsiniz fakat sadece aktif sayfada işlem yapar. Bahsi geçen dört sütuna da veri girişi yapılmadan çalışmaz.
İşinize yarayabilir diye düşünerek, istendiğinde sayfanın sağına listelenebilir (işlem sırasında karşınıza çıkacak iletişim kutularını takip ederek), sonra sorgulamaya devam eder.
Listelenen verilerde gerekli bilgileri göreceksiniz (satır nu. vs.).
Düzeltme işlemi daha pratik olsun diye "Listeden Düzelt" butonunu ekledim:
"AYNI OLANLAR LİSTESİ" altındaki satırlardan ilgili düzeltmeleri yaptıktan sonra, güncellemek istediğiniz satırda herhangi bir hücre (sütun) seçili iken butonu kullanarak (önce onay istedikten sonra) asıl listenizi düzeltebilirsiniz.
(Ön gördüğümce uyarıları ve yönlendirmeleri iletişim kutuları aracılığıyla ekledim)
Burada dikkat etmeniz gereken, buton kullanıldığında hangi hücre seçili ise (aktif hücre) o satırda ki bilgileri günceller. Birden fazla satır seçtiğinizde uyarı vererek işlemi iptal eder. |
Asıl konuya dönecek olursak; sorgulamadaki yönergeler şu şekilde:
Kod, veri girişi satırındaki ilgili dört sütun tamamlandığında çalışır, sadece eşleşme bulduğunda uyarır.
(Deneyerek daha kolay anlayabileceğinizi düşünüyorum zaten)
Önce eşleşenler listelensin mi uyarısı gelir, evet butonu önce listeler sonra sorgulama/kontrol etmeye başlar, hayır butonu sadece sorgulama/kontrol yapar.
(*) Sorgu/Kontrol aşamasında /varsa eşleşen veri satırları uyarısı verir ve veri satırı belirtilir, üç butondan oluşur "Durdur", "Yeniden Dene", "Yoksay"
Durdur butonu: tercih edildiğinde sorguyu bitirir, ilgili satıra yönlendirilmek için onay ister, evet eşleşen satırı gösterir, hayır işlemi bitirir. Durdur butonu kullanıldığında sorgulama bittiğinden dolayı /varsa başka eşleşmeler bulunamaz, ancak sorgulanacak satır (Sheet Change olayını başlatmak için) tekrar çalıştırılırsa (F2+Enter ya da satır hücrelerinden birine çift tık+Enter gibi) sorgulama yeniden başlar.
Yeniden Dene butonu: Veri girişi yaptığınız son hücreyi seçer.
Yoksay butonu: Sorgu/Kontrol işlemine kaldığı yerden devam eder ve bulduğu her eşleşmede "eşleşen veri satırları" uyarısı vererek devam eder (
* satırındaki adımları tekrar takip eder)
İlgili Kodlar ;
Çalışılacak sayfaya:
- Kod: Tümünü seç
Public dz As Boolean
Sub dzlt(dzz As Boolean)
dz = dzz
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sList As Boolean, rw As Long
If dz Like True Then Exit Sub
If Intersect(Target, Range("A:D")) Is Nothing Then Exit Sub
rw = Target.Row
say = Application.CountA(Range("A:A"))
For Each n In Range(Cells(rw, 1), Cells(rw, 4))
If n Like Empty Then Exit Sub
Next n
9:
For Each n In Range("A:A")
If n.Row = rw Then i = i + 1: GoTo atla
If i = say Then If sList = True Then i = 0: sList = False: GoTo 9 Else Exit Sub
If Not n Like Empty Then
If n.Offset(, 1) = Cells(rw, 2) Then
If n = Cells(rw, 1) And n.Offset(, 2) = Cells(rw, 3) And n.Offset(, 3) = Cells(rw, 4) Then GoSub hata
End If
i = i + 1
End If
atla:
Next n
Exit Sub
hata:
If sor = Empty Then If MsgBox("Eşleşen veriler listelensin mi..?", vbYesNo + vbDefaultButton1 + vbInformation, "Uyarı") = vbYes Then _
sor = 1: sList = True: Range(Cells(3, 10), Cells(1048576, 15)).ClearContents Else: sor = 1
If sList = True Then List rw, n.Row: Return
msg = MsgBox("Daha önceden girilen veri tespit edildi." & vbNewLine & vbNewLine & "Veri Satırı: " & n.Row, _
vbAbortRetryIgnore + vbCritical + vbDefaultButton1, "Dikkat..! Veri çakışması.")
Select Case msg
Case vbRetry: Target.Select
Case vbAbort
If MsgBox("İlgili satıra yönlendiriliyorsunuz...", vbYesNo + vbDefaultButton1 + vbInformation, "Uyarı") = vbYes Then: _
Range(Cells(n.Row, 1), Cells(n.Row, 4)).Select: Exit Sub
Case vbIgnore: Return
Case Else: Exit Sub
End Select
End Sub
- Kod: Tümünü seç
Private Function List(tRow As Long, nRow As Long)
dz = True
Application.ScreenUpdating = False
s_say = Application.CountA(Range("J:J")) + 1
Cells(s_say, 10) = s_say - 2
Cells(s_say, 11) = nRow
For yaz = 12 To 15 Step 1
Cells(s_say, yaz) = Cells(nRow, yaz - 11)
Next yaz
Application.ScreenUpdating = True
dz = False
End Function
Modül içerisine:
- Kod: Tümünü seç
Sub düzelt()
Dim rng As String
If Intersect(ActiveCell, Range("J3:O1048576")) Is Nothing Then _
MsgBox "Liste dışında seçim yaptınız", vbOKOnly + vbExclamation, "Listeden Düzelt... UYARI": rng = ActiveCell.Address: _
Range("J3:O1048576").Activate: Application.Wait Now + TimeValue("0:00:01"): Range(rng).Activate: Exit Sub
If Selection.Rows.Count > 1 Then MsgBox "Birden fazla satır seçemezsiniz", vbOKOnly + vbExclamation, "Listeden Düzelt... UYARI": Exit Sub
If MsgBox("Seçili Satır (" & Cells(ActiveCell.Row, 11) & ") Güncellenecek", _
vbYesNo + vbDefaultButton1 + vbInformation, "Uyarı") = vbNo Then Exit Sub
ActiveSheet.dzlt (True)
aRW = Cells(ActiveCell.Row, 11)
vRW = ActiveCell.Row
For yaz = 1 To 4 Step 1
If Cells(aRW, yaz) = Cells(vRW, yaz + 11) Then
Else
Cells(aRW, yaz) = Cells(vRW, yaz + 11): wrt = wrt + 1
End If
Next yaz
If wrt = 0 Then MsgBox "Değişiklik tespit edilemedi" Else MsgBox wrt & " Adet veri değiştirildi."
ActiveSheet.dzlt (False)
End Sub
Umarım işinize yarayacaktır.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Özel Arama
