Skip to main content

AccessTr.neT


A Sayfasında Olan Veri B Sayfasında Varsa A Sayfasındaki İlgili Satırı Silme

A Sayfasında Olan Veri B Sayfasında Varsa A Sayfasındaki İlgili Satırı Silme

#19
(19/11/2020, 01:46)feraz yazdı: Doğru anladımmı bilemiyorum. Deneyiniz.

Private Sub SayfayýHazýrla_Click()

Dim bul As Range, s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Dim arr(), i As Long, son As Long, dogru As Boolean, say As Long, soncomboSayfa As Long

If Len(Trim(Me.ComboBox1.Value)) = 0 Then
    MsgBox "Sayfa seciniz...", vbCritical, "Safa sec"
    Exit Sub
End If

Set s1 = ThisWorkbook.Sheets("VERÝ") 'Veri
Set s2 = ThisWorkbook.Sheets("KONTROL") 'Kontrol
Set s3 = ThisWorkbook.Sheets(Me.ComboBox1.Value)
son = s1.Cells(Rows.Count, 1).End(3).Row
soncomboSayfa = s3.Cells(Rows.Count, "Aj").End(3).Row
If soncomboSayfa < 7 Then soncomboSayfa = 7

If son < 2 Then GoTo son
ReDim arr(1 To son, 1 To 5)
say = 1
On Error Resume Next
s3.Range("A7:E" & soncomboSayfa).ClearContents
On Error GoTo 0
For i = 2 To son
    dogru = False
    Set bul = s2.Range("D:F").Find(s1.Cells(i, 2).Value, , , 1) 'Sicil
    If Not bul Is Nothing Then dogru = True
    Set bul = s2.Range("D:F").Find(s1.Cells(i, 3).Value, , , 1) 'ad
    If Not bul Is Nothing Then dogru = True
    Set bul = s2.Range("D:F").Find(s1.Cells(i, 4).Value, , , 1) 'soyad
    If Not bul Is Nothing Then dogru = True
    Set bul = s2.Range("D:F").Find(s1.Cells(i, 5).Value, , , 1) 'rütbe
    If Not bul Is Nothing Then dogru = True
    If dogru = False Then
        arr(say, 1) = say
        arr(say, 2) = s1.Cells(i, 2).Value
        arr(say, 3) = s1.Cells(i, 5).Value
        arr(say, 4) = s1.Cells(i, 3).Value
        arr(say, 5) = s1.Cells(i, 4).Value
        say = say + 1
    End If
Next
If say > 1 Then
    s3.Range("A7").Resize(say, UBound(arr, 2)).Value = arr
End If

son:
Set s1 = Nothing: Set s2 = Nothing: Set s3 = Nothing: Set bul = Nothing: Erase arr
MsgBox "Bitti", vbInformation, "Bitti"
End Sub
Mobilden yazıyorum.Bu koda göre 4 sütuna göre arıyor döngü kusmı.Eğer herhangi nirinde varsa işlem yapmıyır zaten.Yada ben tam anlayamadım olayı.
Öncedende dediğim gibi 1 ve toplam olayı kolay iş.hata almanızın sebebi sheet içinde sayfaad yazmıştım.Burayı böyle denediyseniz ondandır.Yada son diye değişken tanımlamayıp o değikenle son satır no buldurmadığınızdandır.
Cevapla
#20
(19/11/2020, 20:23)berduş yazdı:
(19/11/2020, 20:14)hayalibey yazdı: Comment kısmı hatalı
bu sorun diğer konunuza ait değil mi?
cevap verirken kimin hangi mesajına cevap verdiğinizi de belirtirseniz anlamak daha kolay olur.
1 - şimdi benim ekldeiğim dosya çalışıyor mu, verileri düzgün gösteriyor mu?
2 - verileri düzgün getiriyorsa eksikleri neler?

Hocam sizin eklediğiniz dosyada hata verdi açamadım dosyayı ekliyorum . Ben güncelledikten sonra çalıştıramadım. Dosyay tekrar bakma imkanınız var mı
Hocam user defined type not defined hatası verdi

(19/11/2020, 20:38)feraz yazdı:
(19/11/2020, 01:46)feraz yazdı: Doğru anladımmı bilemiyorum. Deneyiniz.

Private Sub SayfayýHazýrla_Click()

Dim bul As Range, s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Dim arr(), i As Long, son As Long, dogru As Boolean, say As Long, soncomboSayfa As Long

If Len(Trim(Me.ComboBox1.Value)) = 0 Then
    MsgBox "Sayfa seciniz...", vbCritical, "Safa sec"
    Exit Sub
End If

Set s1 = ThisWorkbook.Sheets("VERÝ") 'Veri
Set s2 = ThisWorkbook.Sheets("KONTROL") 'Kontrol
Set s3 = ThisWorkbook.Sheets(Me.ComboBox1.Value)
son = s1.Cells(Rows.Count, 1).End(3).Row
soncomboSayfa = s3.Cells(Rows.Count, "Aj").End(3).Row
If soncomboSayfa < 7 Then soncomboSayfa = 7

If son < 2 Then GoTo son
ReDim arr(1 To son, 1 To 5)
say = 1
On Error Resume Next
s3.Range("A7:E" & soncomboSayfa).ClearContents
On Error GoTo 0
For i = 2 To son
    dogru = False
    Set bul = s2.Range("D:F").Find(s1.Cells(i, 2).Value, , , 1) 'Sicil
    If Not bul Is Nothing Then dogru = True
    Set bul = s2.Range("D:F").Find(s1.Cells(i, 3).Value, , , 1) 'ad
    If Not bul Is Nothing Then dogru = True
    Set bul = s2.Range("D:F").Find(s1.Cells(i, 4).Value, , , 1) 'soyad
    If Not bul Is Nothing Then dogru = True
    Set bul = s2.Range("D:F").Find(s1.Cells(i, 5).Value, , , 1) 'rütbe
    If Not bul Is Nothing Then dogru = True
    If dogru = False Then
        arr(say, 1) = say
        arr(say, 2) = s1.Cells(i, 2).Value
        arr(say, 3) = s1.Cells(i, 5).Value
        arr(say, 4) = s1.Cells(i, 3).Value
        arr(say, 5) = s1.Cells(i, 4).Value
        say = say + 1
    End If
Next
If say > 1 Then
    s3.Range("A7").Resize(say, UBound(arr, 2)).Value = arr
End If

son:
Set s1 = Nothing: Set s2 = Nothing: Set s3 = Nothing: Set bul = Nothing: Erase arr
MsgBox "Bitti", vbInformation, "Bitti"
End Sub
Mobilden yazıyorum.Bu koda göre 4 sütuna göre arıyor döngü kusmı.Eğer herhangi nirinde varsa işlem yapmıyır zaten.Yada ben tam anlayamadım olayı.
Öncedende dediğim gibi 1 ve toplam olayı kolay iş.hata almanızın sebebi sheet içinde sayfaad yazmıştım.Burayı böyle denediyseniz ondandır.Yada son diye değişken tanımlamayıp o değikenle son satır no buldurmadığınızdandır.


Hocam hatayı çözemedim
.rar Puantaj_YILDIZ.rar (Dosya Boyutu: 313,2 KB | İndirme Sayısı: 0)
.rar Puantaj_YILDIZ.rar (Dosya Boyutu: 313,2 KB | İndirme Sayısı: 0)
Son Düzenleme: 19/11/2020, 20:47, Düzenleyen: hayalibey.
Cevapla
#21
çalışmanızda belirttiğim referansı eklememişsiniz
1 - araçlar
2 - referanslar
3 - microsoft ActiveX Data Object 6.00 Library
not 2:
1 - Kontrol sayfasındaki sicil alanının türünü (F sütunu) metin olarak belirleyin
2 - Veri sayfasındaki sicil alanının türünü (B sütunu) metin olarak belirleyin
[Resim: do.php?img=10597]
https://resim.accesstr.net/do.php?img=10597

sizde referans sürümü 6.1 değil de 2.x benzeri birşey olabilir
.rar Puantaj_YILDIZ_hy.rar (Dosya Boyutu: 388,48 KB | İndirme Sayısı: 5)
Cevapla
#22
(19/11/2020, 20:48)berduş yazdı: çalışmanızda belirttiğim referansı eklememişsiniz
1 - araçlar
2 - referanslar
3 - microsoft ActiveX Data Object 6.00 Library
not 2:
1 - Kontrol sayfasındaki sicil alanının türünü (F sütunu) metin olarak belirleyin
2 - Veri sayfasındaki sicil alanının türünü (B sütunu) metin olarak belirleyin
[Resim: do.php?img=10597]
https://resim.accesstr.net/do.php?img=10597

sizde referans sürümü 6.1 değil de 2.x benzeri birşey olabilir

Berduş Hocam liste çalışıyor ama persnel sayısı bittikten sonra 11 11111111 şeklinde devsam eden kısım pembe oluyor bok kısımlar 30 yazan yerlerde mavi arka planda 0 yazıyor

Boş olan yerler ne pembe ne de mavi olmasın ve içinde hiç bir değer yazmasamakul bir yerden sonra imza bloğu için isimler açılabilir mi

Berduş Hocam bir de aylara veri gelirken kontrol sayfası b sütunundaki rütbe sıralamasına göre gelse
Son Düzenleme: 19/11/2020, 21:07, Düzenleyen: hayalibey.
Cevapla
#23
Renkler yanilmiyorsam sizin yaptığınız koşullu biçimlendirmeden kaynaklanıyor benim dosyamda renklendirme olmuyordu. Imza kısmını yarin uygun bir zamanda eklemeye calisirim

Alıntı:Berduş Hocam bir de aylara veri gelirken kontrol sayfası b sütunundaki rütbe sıralamasına göre gelse
bu haliyle bunu yapabilecek yeterlilikte Excel bilgim yok. Ama rütbe sirlama sutununa sira no ekleyerek belki yapabilirim ama emin değilim.
Cevapla
#24
çok teşekkür ederim Hocam
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task