• Foruma hoş geldin 👋 Ziyaretçi

    Forum içeriğine ve tüm hizmetlerimize erişim sağlamak için foruma kayıt olmalı ya da giriş yapmalısınız. Foruma üye olmak tamamen ücretsizdir.

    Giriş yap veya Şimdi kayıt ol

Çözüldü verileri teke düşürme

Bu konu çözüldü olarak işaretlenmiştir. Çözülmediğini düşünüyorsanız konuyu rapor edebilirsiniz.
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
M

mustafa070707

Yeni Üye
Kullanıcı Bilgileri
Aktiflik
Çevrimdışı
Katılım
9 Ağu 2022
Mesajlar
265
Aldığı beğeni
15
Excel V
Office 2016 TR
Konuyu Başlatan
dosya ekledim yardımlarınızı bekliyorum teşekkürler.
 

Ekli dosyalar

  • VERİLERİ TEKE DÜŞÜRME.xlsm
    20.9 KB · Gösterim: 13
Tarihe göre sırala Oylara göre sırala
Dosyanın içeriğine yazdım burada uzun olmasın diye düşündüm bi art niyetim yoktu
 
Olumlu oy 0 Negatif oyla
Dim sonSatir As Long
sonSatir = syf2.Cells(syf2.Rows.Count, "E").End(xlUp).Row
Dim i As Long
For i = sonSatir To 2 Step -1
If WorksheetFunction.CountA(syf2.Rows(i)) = 0 Then
syf2.Rows(i).Delete
End If
Next i
Genişletmek için tıkla...
kodun altına ekleyip deneyebilir misiniz. sayfaya ve kodlara bakıp anlayabildiğim bu. Ancak hem sayfa1 hem sayfa2 ismi "tek" olarak tanımlanmış bu kodun çalışmaması lazım.

Konuda üslup sorunu var ancak soruyu yazan değil de başka bir arkadaş yol açmış sanki bu soruna.
 
Olumlu oy 0 Negatif oyla
tukayf' Alıntı:
kodun altına ekleyip deneyebilir misiniz. sayfaya ve kodlara bakıp anlayabildiğim bu. Ancak hem sayfa1 hem sayfa2 ismi "tek" olarak tanımlanmış bu kodun çalışmaması lazım.

Konuda üslup sorunu var ancak soruyu yazan değil de başka bir arkadaş yol açmış sanki bu soruna.
Genişletmek için tıkla...
benim paylaştığım kod çalışıyor fakat sizin dediğinizi ekledim herhangi bir değişiklik olmadı
 
Olumlu oy 0 Negatif oyla
mustafa070707' Alıntı:
benim paylaştığım kod çalışıyor fakat sizin dediğinizi ekledim herhangi bir değişiklik olmadı
Genişletmek için tıkla...
hocam ben sayfa2 ye aktaracaksınız diye okudum kodda. O nedenle sayfa2 için düzenlemiştim.
Aynı sayfa için ise
Dim sonSatir As Long
sonSatir = syf1.Cells(syf1.Rows.Count, "E").End(xlUp).Row
Dim i As Long
For i = sonSatir To 2 Step -1
If syf1.Cells(i, 5).Value = "" Then
syf1.Rows(i).Delete
End If
Next i
Genişletmek için tıkla...
bu kodu ekler misiniz.
 
Olumlu oy 0 Negatif oyla
mustafa070707' Alıntı:
benim paylaştığım kod çalışıyor fakat sizin dediğinizi ekledim herhangi bir değişiklik olmadı
Genişletmek için tıkla...
Private Sub CommandButton1_Click()
'teke dusurme ve sıralama

Dim syf1 As Worksheet
Dim syf2 As Worksheet
Set syf1 = Worksheets("tek")
Set syf2 = Worksheets("tek")
Application.ScreenUpdating = False
syf1.Range("A1:D" & syf1.Cells(Rows.Count, "A").End(xlUp).Row).Copy syf2.Range("E2")
syf2.Range("E:H").RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes
Application.ScreenUpdating = True
Columns("e:h").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End Sub
 
Olumlu oy 0 Negatif oyla
mustafa070707' Alıntı:
çok teşekkür ederim elinize sağlık
Genişletmek için tıkla...
Dim sonSatir As Long
sonSatir = syf1.Cells(syf1.Rows.Count, "E").End(xlUp).Row
Dim i As Long
For i = sonSatir To 2 Step -1
If syf1.Cells(i, 5).Value = "" Then
syf1.Range(syf1.Cells(i, 5), syf1.Cells(i, 8)).Delete
End If
Next i
Genişletmek için tıkla...
bunu kodu kullanın lütfen. bir kaç deneme yapar mısınız.
 
Olumlu oy 1 Negatif oyla
Çözüm
Deneyiniz.
Kod:
Değerli Misafirimiz İçeriği Görebilmek İçin Üyemiz İseniz Giriş Yap'ın Ya da Üye Ol'un.
 
Olumlu oy 0 Negatif oyla
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
Geri
Üst