Variable Already in Use hatası

[muysun35]

Private Sub CommandButton7001_Click() 'giriş satırını sil butonu
Application.ScreenUpdating = False
Dim bulvesill As Range, syftmi As Worksheet, syfstlr As Worksheet, syfstlmzl As Worksheet
Set syftmi = Sheets("tumislemler")
Set syfstlr = Sheets("SatilirLotlar")
Set syfstlmzl = Sheets("Satilamaz")
For Each bulvesill In syftmi.Range("a2:a" & syftmi.Range("a65536").End(3).Row)
If Not bulvesill Is Nothing And bulvesill = TextBox1709.Text Then
syftmi.Rows(bulvesill.Row).Delete Shift:=xlUp

If TextBox1709.Text Like "101-*" Then
For Each bulvesill In syfstlr.Range("a2:a" & syfstlr.Range("a65536").End(3).Row)
bulvesill.Offset(0, 0).Value = ""
bulvesill.Offset(0, 1).Value = ""
bulvesill.Offset(0, 2).Value = ""
bulvesill.Offset(0, 3).Value = ""
bulvesill.Offset(0, 4).Value = ""
bulvesill.Offset(0, 5).Value = ""
bulvesill.Offset(0, 6).Value = ""
Next

ElseIf TextBox1709.Text Like "311-*" Then
For Each bulvesill In syfstlmzl.Range("a2:a" & syfstlmzl.Range("a65536").End(3).Row)
bulvesill.Offset(0, 0).Value = ""
bulvesill.Offset(0, 1).Value = ""
bulvesill.Offset(0, 2).Value = ""
bulvesill.Offset(0, 3).Value = ""
bulvesill.Offset(0, 4).Value = ""
bulvesill.Offset(0, 5).Value = ""
bulvesill.Offset(0, 6).Value = ""
Next
End If
End If
Next

MsgBox "İşlem Silindi"
Application.ScreenUpdating = True
End Sub

şeklinde kodlarım mevcut...
textbox1709 da bulunan değeri içeren satırı siler (Tüm İşlemler Sayfasında)
eğer Tb1709 değeri 101- ile başlarsa, "satılırLotlar" sayfasında değeri bulur; bu hücreyi ve sağındaki 6 hücre içeriğini temizler
eğer tb1709 değeri 311- ile başlarsa, "satılamaz" sayfasında değeri bulur; bu hücreyi ve sağındaki 6 hücre içeriğini temizler

bulvesill değişkeni için "for control variable Already in Use" hatası veriyor.
Yardımcı olabilecek arkadaşlara şimdiden teşekkürler.

 

[Ömer]

Merhaba,

Gördüğüm kadarıyla 2. döngünün adı da ilk döngüyle aynı. Farklı ad vererek yazdım. (a_bulvesill)
Deneyiniz.

Private Sub CommandButton7001_Click() 'giriş satırını sil butonu

Application.ScreenUpdating = False

Dim bulvesill As Range, a_bulvesill As Range
Dim syftmi As Worksheet, syfstlr As Worksheet, syfstlmzl As Worksheet

Set syftmi = Sheets("tumislemler")
Set syfstlr = Sheets("SatilirLotlar")
Set syfstlmzl = Sheets("Satilamaz")

For Each bulvesill In syftmi.Range("a2:a" & syftmi.Range("a65536").End(3).Row)
    If Not bulvesill Is Nothing And bulvesill = TextBox1709.Text Then
        syftmi.Rows(bulvesill.Row).Delete Shift:=xlUp

        If TextBox1709.Text Like "101-*" Then
            For Each a_bulvesill In syfstlr.Range("a2:a" & syfstlr.Range("a65536").End(3).Row)
                a_bulvesill.Offset(0, 0).Value = ""
                a_bulvesill.Offset(0, 1).Value = ""
                a_bulvesill.Offset(0, 2).Value = ""
                a_bulvesill.Offset(0, 3).Value = ""
                a_bulvesill.Offset(0, 4).Value = ""
                a_bulvesill.Offset(0, 5).Value = ""
                a_bulvesill.Offset(0, 6).Value = ""
            Next

        ElseIf TextBox1709.Text Like "311-*" Then
            For Each a_bulvesill In syfstlmzl.Range("a2:a" & syfstlmzl.Range("a65536").End(3).Row)
                a_bulvesill.Offset(0, 0).Value = ""
                a_bulvesill.Offset(0, 1).Value = ""
                a_bulvesill.Offset(0, 2).Value = ""
                a_bulvesill.Offset(0, 3).Value = ""
                a_bulvesill.Offset(0, 4).Value = ""
                a_bulvesill.Offset(0, 5).Value = ""
                a_bulvesill.Offset(0, 6).Value = ""
            Next
        End If
    End If
Next

MsgBox "İşlem Silindi"
Application.ScreenUpdating = True

End Sub

 

[muysun35]

@Ömer Hocam selamlar. bu şekilde satılırlotlar sayfasındaki tüm girişleri siliyor..

 

[muysun35]

sıkıntı
a_bulvesill değişkenine değer atamayla ilgili..
hata veriyor ve a_bulvesill değeri nothing olarak görünüyor.. bu değişkene Tb1709 daki değeri atamaya çalıştığımda ise hata veriyor..
bulvesill = a_bullvesill dediğimde de hata veriyor

bir textbox içindeki değeri, koşula göre (101 ya da 311 le başlamasına bağlı olarak) iki farklı sayfada arayacak, daha sonra da sayfalardan birindeki (tüm işlemler) satırı tamamen silecek,
koşula bağlı olarak satılırlotlar ya da satılamaz sayfalarında ise texboxtaki değerin bulunduğu satırdaki 7 hücreyi silecek bir koda ihtiyacım var.

mantığı kurguladım ancak, kodlama konusunda atladığım bir yer var..

 

[Ömer]

Ben mantığına bakmamıştım.

O halde sizin istediğiniz: (benim anladığım)

Değeri önce "tumislemler" sayfası A sütununda arasın varsa satırı silsin.

sonra devam ederek;

eğer değer "101-*" ise "SatilirLotlar" sayfası A sütununda arasın varsa kendisi ve sağındaki 6 hücreyi silsin.

eğer değer "311-*" ise "Satilamaz" sayfası A sütununda arasın varsa kendisi ve sağındaki 6 hücreyi silsin.

Eğer istediğiniz buysa kodları yeniden düzenlemekte fayda var.

 

[muysun35]

Ben mantığına bakmamıştım.

O halde sizin istediğiniz: (benim anladığım)

Değeri önce "tumislemler" sayfası A sütununda arasın varsa satırı silsin.

sonra devam ederek;

eğer değer "101-*" ise "SatilirLotlar" sayfası A sütununda arasın varsa kendisi ve sağındaki 6 hücreyi silsin.

eğer değer "311-*" ise "Satilamaz" sayfası A sütununda arasın varsa kendisi ve sağındaki 6 hücreyi silsin.

Eğer istediğiniz buysa kodları yeniden düzenlemekte fayda var.

tamamen doğru anlamışsınız hocam...

 

[Ömer]

Deneyiniz.

Private Sub CommandButton7001_Click() 'giriş satırını sil butonu
    
    Dim syftmi As Worksheet, syfstlr As Worksheet, syfstlmzl As Worksheet
    Dim c As Range, k As Range, Adr As String, deg
    
    Set syftmi = Sheets("tumislemler")
    Set syfstlr = Sheets("SatilirLotlar")
    Set syfstlmzl = Sheets("Satilamaz")
    deg = TextBox1709.Text
    
    Application.ScreenUpdating = False
    
    Set c = syftmi.[A:A].Find(deg, , xlValues, xlWhole)
    If Not c Is Nothing Then
        Adr = c.Address
        Do
            If k Is Nothing Then
                Set k = syftmi.Rows(c.Row)
            Else
                Set k = Application.Union(k, syftmi.Rows(c.Row))
            End If
            Set c = syftmi.[A:A].FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adr
    End If
    If Not k Is Nothing Then k.Delete
    
    Set k = Nothing
    If deg Like "101-*" Then
        Set c = syfstlr.[A:A].Find(deg, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                If k Is Nothing Then
                    Set k = syfstlr.Cells(c.Row, "A").Resize(1, 6)
                Else
                    Set k = Application.Union(k, syfstlr.Cells(c.Row, "A").Resize(1, 6))
                End If
                Set c = syfstlr.[A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
        If Not k Is Nothing Then k.ClearContents
        
    ElseIf deg Like "311-*" Then
        Set c = syfstlmzl.[A:A].Find(deg, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                If k Is Nothing Then
                    Set k = syfstlmzl.Cells(c.Row, "A").Resize(1, 6)
                Else
                    Set k = Application.Union(k, syfstlmzl.Cells(c.Row, "A").Resize(1, 6))
                End If
                Set c = syfstlmzl.[A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
        If Not k Is Nothing Then k.ClearContents
    End If
    
    MsgBox "İşlem Silindi"
    Application.ScreenUpdating = True

End Sub

 

[muysun35]

Deneyiniz.

hocam eline emeğine sağlık.. teşekkür ederim

 

[muysun35]

@Ömer Hocam yine rahatsız ediyorum ama..
sıkıntısız çalışıyor ancak bir sorum daha var...
.ClearContents ile içini boşalttığı hücreleri yukarı doğru silebilir mi? mesela aşağıdaki resimde 8. satır boş. sizin kodlar bunu sildi.. ama o aradaki boşluk kısmını yukarı doğru silebilir miyiz?
örnekte 8. satırdaki boşluk veya 13. satırdaki boşlukların yok olmasına ve listenin peşpeşe devam etmesine çalışıyorum..

k.Delete Shift=xlup denedim ama sonuç alamadım...

 

[muysun35]

NOT: I ve J kolonların veri var. bu nedenle tüm satırı değil de, sadece içi boş olan hücre aralığını sildirmek gerekli..

 

[Ömer]

Merhaba,

k.Delete Shift:=xlUp

Bu şekilde yazınca olması gerekir? Tekrar kontrol eder misiniz. Eğer olmuyorsa küçük bir örnek ekler misiniz.

 

[muysun35]

tum işlemler sayfasında tüm satırı sildiği için sıkıntı yok zaten.. diyelim ki 101 le başlayan işlemlerden birini silmek istiyorum...

If deg Like "101-*" Then
Set c = syfstlr.[A:A].Find(deg, , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
If k Is Nothing Then
Set k = syfstlr.Cells(c.Row, "A").Resize(1, 7)
Else
Set k = Application.Union(k, syfstlr.Cells(c.Row, "A").Resize(1, 7))
End If
Set c = syfstlr.[A:A].FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
'(If Not k Is Nothing Then k.ClearContents yerine)
If Not k Is Nothing Then k.Delete Shift:=XlUp 'denedim..

bununla birlikte

If deg Like "101-*" Then
Set c = syfstlr.[A:A].Find(deg, , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
If k Is Nothing Then
Set k = syfstlr.Cells(c.Row, "A").Resize(1, 7)
Else
Set k = Application.Union(k, syfstlr.Cells(c.Row, "A").Resize(1, 7))
'------Bu alana ilave yaptım
k.Select
Selection.Delete Shift:=XlUp
'-------
End If
Set c = syfstlr.[A:A].FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
If Not k Is Nothing Then k.ClearContents

her iki durumda da, unionla alınan hücrelerin içeriğini temizliyor ama hücreleri silmiyor..

 

[muysun35]

k.ClearContents

yerine k.Clear kullanırsak, hücre formatını (kenarlıkları vs) temizliyor.

 

[Ömer]

Eğer silinecek veriler A:H arasındaysa;

Resize(1, 6)
6 ların yerine 8 yazmanız gerekir. İstediğiniz bu sanırım.

Silme için sizin de yazdığınız gibi.
k.ClearContents ': aralıktaki verileri siler.
k = "" ': aralıktaki verileri boş bırakır yani siler.
k.Clear ': biçimleride siler.
k.Delete Shift:=xlUp 'hücreleri yukarı sürükleyerek siler.

 

[muysun35]

Eğer silinecek veriler A:H arasındaysa;
Resize(1, 6)
6 ların yerine 8 yazmanız gerekir. İstediğiniz bu sanırım.

A ve I arasında. ben o alan Resize(1, 7) şeklinde revize ettim hocam.. satır siliyor.

k.Delete Shift:=xlUp şeklinde olması lazım ama tuhaf bir şekilde çalışmıyor.

 

[muysun35]

A ve I arasında. ben o alan Resize(1, 7) şeklinde revize ettim hocam.. satır siliyor.

k.Delete Shift:=xlUp şeklinde olması lazım ama tuhaf bir şekilde çalışmıyor.

A ve G arasında