• DİKKAT

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

Makro kod düzenleme

igultekin2000

igultekin2000

Katılım
5 Eylül 2007
Mesajlar
1,247
Excel Vers. ve Dili
ofis 2010
Sub sill_KOD_SILME()
Dim sil As Integer
Set s1 = ThisWorkbook.Worksheets("data")
Set s2 = ThisWorkbook.Worksheets("silinen")
sonsat = Range("A65536").End(xlUp).Row
For sil = sonsat To 2 Step -1
If WorksheetFunction.CountIf(Sheets("kodlar").Range("a2:a2000"), s1.Cells(sil, "A")) = 0 _
And WorksheetFunction.CountIf(Sheets("kodlar").Range("a2:a2000"), s1.Cells(sil, "B")) = 0 Then
sonsatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = s1.Cells(sil, 1)
s2.Cells(sonsatir, 2) = s1.Cells(sil, 2)
s2.Cells(sonsatir, 3) = s1.Cells(sil, 3)
s2.Cells(sonsatir, 4) = s1.Cells(sil, 4)
s2.Cells(sonsatir, 5) = s1.Cells(sil, 5)
s2.Cells(sonsatir, 6) = s1.Cells(sil, 6)
s2.Cells(sonsatir, 7) = s1.Cells(sil, 7)
Rows(sil).Delete shift:=xlUp
End If
Next sil
End Sub

iyi günler; veri düzenlemesinde kullandığım yukarıdaki kodda düzeltme yapmak istiyorum. "kodlar" çalışma sayfasının " A " sütununa yazdığım kodlar " data " sayfasının " B " sütununda ise o kod dışındaki verileri satır bazında silerek " silinen " sayfasına atıyor. "kodlar" çalışma sayfasının "A" sütununa yazdığım kodlar uzun olduğu için baştan sadece " 3 " sayıyı yani "120 0001, 120 0002, 340 0001, 101 00, 121 000 gibi kodlarda 120,340,101,121 gibi " ilk üç değeri baz alarak silme yapmasını ve silinenlerin " silinen " sayfasına atmak yerine tamamen sayfaya atılmadan silinmesi istiyorum. Yardımcı olabilecek arkadaşlara teşekkür ederim.
 
igultekin2000' Alıntı:
Sub sill_KOD_SILME()
Dim sil As Integer
Set s1 = ThisWorkbook.Worksheets("data")
Set s2 = ThisWorkbook.Worksheets("silinen")
sonsat = Range("A65536").End(xlUp).Row
For sil = sonsat To 2 Step -1
If WorksheetFunction.CountIf(Sheets("kodlar").Range("a2:a2000"), s1.Cells(sil, "A")) = 0 _
And WorksheetFunction.CountIf(Sheets("kodlar").Range("a2:a2000"), s1.Cells(sil, "B")) = 0 Then
sonsatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = s1.Cells(sil, 1)
s2.Cells(sonsatir, 2) = s1.Cells(sil, 2)
s2.Cells(sonsatir, 3) = s1.Cells(sil, 3)
s2.Cells(sonsatir, 4) = s1.Cells(sil, 4)
s2.Cells(sonsatir, 5) = s1.Cells(sil, 5)
s2.Cells(sonsatir, 6) = s1.Cells(sil, 6)
s2.Cells(sonsatir, 7) = s1.Cells(sil, 7)
Rows(sil).Delete shift:=xlUp
End If
Next sil
End Sub
Genişletmek için tıkla ...
Merhaba.

Yanlış anlamadıysam, kırmızı renklendirdiklerimi silip mavi olanların yerine aşağıdaki satırları eklemeniz yeterli olacaktır.
Kod: 
[SIZE="2"]If WorksheetFunction.CountIf(Sheets("kodlar").Range(" A2:A2000"), Mid(s1.Cells(sil, "A"), 1, 3) & "*") = 0 _
And WorksheetFunction.CountIf(Sheets("kodlar").Range(" A2:A2000"), Mid(s1.Cells(sil, "B"), 1, 3) & "*") = 0 Then[/SIZE]
.
 
Son düzenleme:
Ömer BARAN' Alıntı:
Merhaba.

Yanlış anlamadıysam, kırmızı renklendirdiklerimi silip mavi olanların yerine aşağıdaki satırları eklemeniz yeterli olacaktır.
Kod: 
[SIZE="2"]If WorksheetFunction.CountIf(Sheets("kodlar").Range(" A2:A2000"), Mid(s1.Cells(sil, "A"), 1, 3) & "*") = 0 _
And WorksheetFunction.CountIf(Sheets("kodlar").Range(" A2:A2000"), Mid(s1.Cells(sil, "B"), 1, 3) & "*") = 0 Then[/SIZE]
.
Genişletmek için tıkla ...

bir yerde aksilik var ama çözemedim. yeni kodla " data " sayfasındaki bilginin tamamını siliyor. ancak And Worksheet' le başlayan satırdaki "kodlar" yazan yeri "data" ve A2:A2000 yazan yerdeki B2:B2000 olarak değiştirdiğimde ne ilginç "kodlar" kısmına yazdığım sadece 101 kodu "data" sayfasın silmeyip diğer ne yazarsam siliyor. Çözemedim.
 
Kod'un anlamı; herbir satır için kontrol edilen iki şey var ve ikisi de gerçekleşirse satırı sil.
Aynı satırda olmak üzere; kodlar sayfasının A sütununda,
-- data sayfası A sütunundaki değerin ilk 3 karakteriyle başlayan değer var mı?
-- data sayfası B sütunundaki değerin ilk 3 karakteriyle başlayan değer var mı?
Kontrol edilen satır için, her iki koşulun cevabı da YOK ise satırı siler.

İsterseniz örnek belge ekleyin ve örnek belgede, şu satır şu nedenle silinecek, şu satır şu nedenle silinmeyecek gibi açıklama ekleyin.
.
 
Merhaba;
Alternatif olsun.
İnceleyin.

Not:Altın üye olmanıza rağmen sorunuzu neden örnek dosya ile desteklemiyorsunuz?
Bu soruyu net çözmek için gerekli sayfaları oluşturmak , deneme verisi girmek gerektiğini biliyorsunuzdur.

Sub sill_KOD_SILME()
Dim uzunluk, aranan
Set s1 = ThisWorkbook.Worksheets("kodlar")
Set s2 = ThisWorkbook.Worksheets("data")
sonsat = s2.Range("A65536").End(xlUp).Row
For i = 2 To s1.Range("A65536").End(xlUp).Row
uzunluk = Len(s1.Cells(i, 1))
aranan = Left(s1.Cells(i, 1), uzunluk)
For k = sonsat To 2 Step -1
bulunan = Left(s2.Cells(k, 2), uzunluk)
If aranan <> bulunan Then
s2.Rows(k).Delete shift:=xlUp
say = say + 1
End If
Next k
Next i
If say >= 1 Then MsgBox (say & " adet veri silindi.")
If say = 0 Then MsgBox ("Silinecek veri BULUNAMADI."), vbCritical
End Sub
 
muygun' Alıntı:
Merhaba;
Alternatif:
Eki deneyin.
İyi çalışmalar.
Genişletmek için tıkla ...

içerik olarak olmuş gibi ancak kod bölümüne yazdığımız kodların ilk üç rakamına göre işlem yapmıyor yani kod kısmına 101,120,320 gibi yazdığımda data kısmında 101 00, 320 0001, 120 001 gibi kod olduğu için sadece 120 ve uzantısını silmiyor, diğer 101 00, 320 001 gibi kodlarda tamamını siliyor, sorgulayıp silmede kod' da yazılan ilk üç rakama göre silme yapmıyor
 
Merhaba.

Sayın muygun'un örnek belgesini incelemedim.

Aşağıdaki kod'u dener misiniz?
Uyarı: Kod, kodlar sayfası B sütununu kullandığından bu alana veri yazarsanız silinir.
.
Kod: 
[FONT="Arial Narrow"]Sub SATIR_SIL()
Set kodlar = Sheets("kodlar"): Set Data = Sheets("data")
Set WF = Application.WorksheetFunction
    With kodlar.Range("B2:B" & kodlar.[A65536].End(3).Row)
        .Formula = "=Left(A2,3)&""""": .Value = .Value
    End With
For datasat = Data.[A65536].End(3).Row To 2 Step -1
    If WF.CountIf(kodlar.Range("B2:B" & kodlar.[A65536].End(3).Row), Mid(Data.Cells(datasat, 2), 1, 3) & "") = 0 Then _
    Data.Rows(datasat).Delete shift:=xlUp
Next
kodlar.Range("B:B").ClearContents: MsgBox "İŞLEM TAMAM...", vbInformation, "..::  igultekin2000  ::.."
End Sub[/FONT]
 
Merhaba;
Son gönderdiğim dosyada kodlar sayfasında B1 hücresindeki rakamı 3 yapın.
(açıklama yazmıştım ama sonradan silmişim.)
Buradaki sayı ilk kaç karaktere göre işlem yapacağınızı belirler.
 
sorun çözüldü

Ömer BARAN' Alıntı:
Merhaba.

Sayın muygun'un örnek belgesini incelemedim.

Aşağıdaki kod'u dener misiniz?
Uyarı: Kod, kodlar sayfası B sütununu kullandığından bu alana veri yazarsanız silinir.
.
Kod: 
[FONT="Arial Narrow"]Sub SATIR_SIL()
Set kodlar = Sheets("kodlar"): Set Data = Sheets("data")
Set WF = Application.WorksheetFunction
    With kodlar.Range("B2:B" & kodlar.[A65536].End(3).Row)
        .Formula = "=Left(A2,3)&""""": .Value = .Value
    End With
For datasat = Data.[A65536].End(3).Row To 2 Step -1
    If WF.CountIf(kodlar.Range("B2:B" & kodlar.[A65536].End(3).Row), Mid(Data.Cells(datasat, 2), 1, 3) & "") = 0 Then _
    Data.Rows(datasat).Delete shift:=xlUp
Next
kodlar.Range("B:B").ClearContents: MsgBox "İŞLEM TAMAM...", vbInformation, "..::  igultekin2000  ::.."
End Sub[/FONT]
Genişletmek için tıkla ...

evet bu şekilde sorunsuz çalışıyor, acaba bundan bağımsız ilave bir kod daha olsa " data "sayfasında işlemler bittikten sonra " B ve G " sütununda aynı olan kodlarda satır olarak silinebilir mi?
Teşekkürler. yani işlemden sonra B2 sütunda 120 001 ve G2 sütununda da 120 001 gibi aynı kod oluştuğunda da o satırın silinmesi şeklinde
 
Umarım yanlış anlamadım. Verdiğim kod'un ilgili kısmını aşağıdakiyle değiştirerek dener misiniz?
.
Kod: 
[FONT="Arial Narrow"]For datasat = Data.[A65536].End(3).Row To 2 Step -1
    If WF.CountIf(kodlar.Range("B2:B" & kodlar.[A65536].End(3).Row), Mid(Data.Cells(datasat, 2), 1, 3) & "") = 0 [COLOR="Red"][B]_[/B][/COLOR]
    [COLOR="Blue"]Or Data.Cells(datasat, 2) = Data.Cells(datasat, 7) [/COLOR]Then _
    Data.Rows(datasat).Delete shift:=xlUp
Next[/FONT]
 
Ömer BARAN' Alıntı:
Umarım yanlış anlamadım. Verdiğim kod'un ilgili kısmını aşağıdakiyle değiştirerek dener misiniz?
.
Kod: 
[FONT="Arial Narrow"]For datasat = Data.[A65536].End(3).Row To 2 Step -1
    If WF.CountIf(kodlar.Range("B2:B" & kodlar.[A65536].End(3).Row), Mid(Data.Cells(datasat, 2), 1, 3) & "") = 0 [COLOR="Red"][B]_[/B][/COLOR]
    [COLOR="Blue"]Or Data.Cells(datasat, 2) = Data.Cells(datasat, 7) [/COLOR]Then _
    Data.Rows(datasat).Delete shift:=xlUp
Next[/FONT]
Genişletmek için tıkla ...

Teşekkürler sorunsuz çalışıyor
 
teşekkürler

muygun' Alıntı:
Merhaba;
Son gönderdiğim dosyada kodlar sayfasında B1 hücresindeki rakamı 3 yapın.
(açıklama yazmıştım ama sonradan silmişim.)
Buradaki sayı ilk kaç karaktere göre işlem yapacağınızı belirler.
Genişletmek için tıkla ...

teşekkürler, bu makro başka amaçlıda kullanabileceğim türden.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst