Koşula Göre Satır Silmek

[ywzyilmaz]

Merhaba

Forumda biraz araştırma yaptım bir kaç konu bulup inceledim ama oluşturduğum kodlar çalışmadı.
sayfa 1 deki bir hücrenin değerine sayfa2 deki b hücresinde arayıp bulunduğu satırı önce sayfa 3te A2 hücresinden başalıp sıralayacak sonra sayfa 2den komple silecek bir kod yazmaya çalıştım. Makro ile filtreleme ve silme kodunu aldım filtreleme değerini ise bir değişkene tanımlamaya çalıştım.

Sub satirsil()
Dim barkodsil As String
    barkodsil = Sheets("sayfa1").Range("T3")
    Sheets("Barkodlist").Select
    ActiveSheet.Range("$A:$G").AutoFilter Field:=2, Criteria1:=barkodsil
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
End Sub

kodlar çalışmıyor nerede hata yaptığımı bulamadım.

 

[asi_kral]

Merhaba
Aradığınız değer sayfa1 de A1 hücresi baz alınmıştır.

sub sil()
dim S1 as worksheet,S2 as worksheet,S3 as worksheet
Dim STR1 as long,STR2 as long
set S1 = sheets("Sayfa1")
set S2 = sheets("Sayfa2")
set s3 = Sheets("Sayfa3")
str2=s3.range("A"& rows.count).end(xlup).row +1
if worksheetfunction.countif(s2.range("B:B"),s1.range("A1"))>0 then
str1=s2.range("B" &worksheetfunctlion.match(s1.range("A1"),s2.range("B:B"),0))
End if
s3.range("A"&str2)= s2.range("B"& Str1)
s2.range("B"& str1).delete xlup
msgbox "İşlem Tamam"
end

Not : Kod ezber yazilmistir. PC basinda olan arkadaşlar da bakabilirse düzeltebiliriz.

 

[ywzyilmaz]

Merhaba
Aradığınız değer sayfa1 de A1 hücresi baz alınmıştır.

sub sil()
dim S1 as worksheet,S2 as worksheet,S3 as worksheet
Dim STR1 as long,STR2 as long
set S1 = sheets("Sayfa1")
set S2 = sheets("Sayfa2")
set s3 = Sheets("Sayfa3")
str2=s3.range("A"& rows.count).end(xlup).row +1
if worksheetfunction.countif(s2.range("B:B"),s1.range("A1"))>0 then
str1=s2.range("B" &worksheetfunctlion.match(s1.range("A1"),s2.range("B:B"),0))
End if
s3.range("A"&str2)= s2.range("B"& Str1)
s2.range("B"& str1).delete xlup
msgbox "İşlem Tamam"
end

Not : Kod ezber yazilmistir. PC basinda olan arkadaşlar da bakabilirse düzeltebiliriz.

Merhaba

Sub satirsil()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim STR1 As Long, STR2 As Long
Set S1 = Sheets("Olustur")
Set S2 = Sheets("Barkodlist")
Set S3 = Sheets("Delbarkod")
STR2 = S3.Range("A" & Rows.Count).End(xlUp).Row + 1
If WorksheetFunction.CountIf(S2.Range("B:B"), S1.Range("T3")) > 0 Then
STR1 = S2.Range("B" & worksheetfunctlion.Match(S1.Range("T3"), S2.Range("B:B"), 0))
End If
S3.Range("A" & STR2) = S2.Range("B" & STR1)
S2.Range("B" & STR1).Delete xlUp
MsgBox "İşlem Tamam"
End
End Sub

kodları bu şekilde kendime göre düzenledim. fakat
STR1 = S2.Range("B" & worksheetfunctlion.Match(S1.Range("T3"), S2.Range("B:B"), 0))

bu satırda hata alıyorum.

 

[ywzyilmaz]

Tekrar merhaba o satırda functlion olarak yazıldığı için hata veriyormuş. onu düzelttim fakat şimdi bu satırda hata veriyor.

S3.Range("A" & STR2) = S2.Range("B" & STR1)

 

[asi_kral]

Merhaba
Pc de olunca işlem tamam sanırım.

Sub sil()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim STR1 As Long, STR2 As Long
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
Set S3 = Sheets("Sayfa3")
STR2 = S3.Range("A" & Rows.Count).End(xlUp).Row + 1
If WorksheetFunction.CountIf(S2.Range("B:B"), S1.Range("A1")) > 0 Then
STR1 = S2.Range("B" & WorksheetFunction.Match(S1.Range("A1"), S2.Range("B:B"), 0))
S3.Range("A" & STR2) = S2.Range("B" & STR1)
S2.Range("B" & STR1).Delete xlUp
End If
MsgBox "İşlem Tamam"
End Sub

 

[ywzyilmaz]

Merhaba
Pc de olunca işlem tamam sanırım.

Sub sil()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim STR1 As Long, STR2 As Long
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
Set S3 = Sheets("Sayfa3")
STR2 = S3.Range("A" & Rows.Count).End(xlUp).Row + 1
If WorksheetFunction.CountIf(S2.Range("B:B"), S1.Range("A1")) > 0 Then
STR1 = S2.Range("B" & WorksheetFunction.Match(S1.Range("A1"), S2.Range("B:B"), 0))
S3.Range("A" & STR2) = S2.Range("B" & STR1)
S2.Range("B" & STR1).Delete xlUp
End If
MsgBox "İşlem Tamam"
End Sub

Merhaba

S3.Range("A" & STR2) = S2.Range("B" & STR1)

bu satırda hata alıyorum.

 

[ywzyilmaz]

Merhaba
Pc de olunca işlem tamam sanırım.

Sub sil()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim STR1 As Long, STR2 As Long
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
Set S3 = Sheets("Sayfa3")
STR2 = S3.Range("A" & Rows.Count).End(xlUp).Row + 1
If WorksheetFunction.CountIf(S2.Range("B:B"), S1.Range("A1")) > 0 Then
STR1 = S2.Range("B" & WorksheetFunction.Match(S1.Range("A1"), S2.Range("B:B"), 0))
S3.Range("A" & STR2) = S2.Range("B" & STR1)
S2.Range("B" & STR1).Delete xlUp
End If
MsgBox "İşlem Tamam"
End Sub

yeni bir excell açıp verdiğiniz kodu çalıştırdım. makro çalışıyor ama işlem yapmıyor.

 

[asi_kral]

Gerçek veri olmayan dosyanızı ekler misiniz?
Onun üzerinden bakayım.
Boş dosyada denerseniz işlem yapmaz çünkü veri bulamaz.