İçinde "0" olan satırların silinmesi.

[mtongur]

Ekteki dosyada açıklama yaptım Sayın Üstadlarım.





Uploaded with ImageShack.us

 

[Orion1]

Sub sil_59()
'Aktif sayfada B sütununda sıfır olan satır comple siliniyor
Dim i As Long, sat As Long
sat = Cells(65536, "B").End(xlUp).Row
Application.ScreenUpdating = False
For i = sat To 1 Step -1
    If Cells(i, "B").Value <> "" And Cells(i, "B").Value _
    = 0 Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
MsgBox "B sütunda sıfır olan satır comple silindi." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[mtongur]

Sn. Evren Üstadım;

Çok teşekkürler. Kod butonla oldu. Peki bunu buton olmadan otomatik olarak yapabilirmiyiz. yani hücre sıfıra düşünce satırın direk silinmesi gibi.

 

[Orion1]

Sn. Evren Üstadım;

Çok teşekkürler. Kod butonla oldu. Peki bunu buton olmadan otomatik olarak yapabilirmiyiz. yani hücre sıfıra düşünce satırın direk silinmesi gibi.

Sıfıra nasıl düşecek?
Sıfıra düşmesine göre kod yazılabailir.

 

[Orion1]

Sn. Evren Üstadım;

Çok teşekkürler. Kod butonla oldu. Peki bunu buton olmadan otomatik olarak yapabilirmiyiz. yani hücre sıfıra düşünce satırın direk silinmesi gibi.

Eğer manuel giriyorsanız b sütununa ,aşağıdaki kod bloğunu ilgili sayfanın modülüne yapıştırınız.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
On Error GoTo son
If Target.Value <> "" And Target.Value = 0 Then Rows(Target.Row).Delete
son:
End Sub

 

[mtongur]

İşyerinde olduğum için dosya veya resim ekleyemiyorum. Diğer resimde gördüğünüz kontrol sayfası var. Orada ürünün kodunu girip yeni stok olarak 0 yapıyorum ve değiştir butonuyla adresteki miktarı sıfırlıyorum. Akşam gerekli resmi ekleyeceğim. Kroki üzerinde direk adrese giden butonlar ve yanlarında o adresteki ürün miktarını gösteren hücreler var. buralarda ürün adetlerini görüyorum ve değiştiriyorum.
Ben birde bu program için kamera ve barkot sistemi düşünüyorum. Barkot kısmını ayarlarım bir şekilde ancak; kamera ile ilgili görüşlerinizi almak istiyorum. resimde gördüğünüz adres sayfalarından her birinde canlı video görüntüsü almam gerekiyor. her adres ayrı bir kamera ama videoları sayfalarda nasıl gösteririm bilmiyorum. Misal A1 sayfasına geldiğimde resimdeki tablonun yanında videoyu da canlı olarak görebilmem gerekiyor. Bu mümkün mü?

 

[F650GS]

aynı sonuca formüller kullanarak nasıl ulaşabiliriz?

 

[Korhan Ayhan]

Selamlar,

aynı sonuca formüller kullanarak nasıl ulaşabiliriz?

Kastettiğiniz formülle satır silmek ise bu işlem yapılamaz. Ama formül ve filtreleme yöntemini bir arada kullanarak yapabilirsiniz.

Boş bir sütuna sıfır olan hücre değerini formülle sorgulatıp ayrıştırıcı bir değer verdikten sonra bu sütuna filtre uygulayıp formül sonucu oluşan değeri süzebilirsiniz. Süzme işleminden sonra satırları seçtikten sonra alan üzerinde sağ klik yapıp silme işlemini yapabilirsiniz.

=EĞER(B4=0;"Satırı Sil";"")

 

[mtongur]

İlgili resimde "0" yaptığım kısımdan bahsettim. Buna göre yapmam gerekiyor.
Saygılar

 

[Korhan Ayhan]

Selamlar,

DEĞİŞTİR makronuzu buraya eklermisiniz. Üzerinde düzenleme yapalım. Hatta örnek dosyanızı eklerseniz daha hızlı sonuca gidebiliriz.

 

[mtongur]

Korhan Bey;
Program tam olmadan yayınlamak istemiyorum.
isterseniz özelden mail adresinizi verirseniz size mail olarak atabilirim.

Sub degistir()
Dim k As Byte, i As Byte
For k = 3 To 15 Step 4
    For i = 9 To 33 Step 2
        If Sheets("KONTROL").Cells(i, k).Value = "" Then GoTo atla
        syf = Cells(i, k).Value
        Set j = Sheets(syf).Range("A:A").Find(Sheets("KONTROL").TextBox2.Value, , xlValues, xlWhole)
        If Not j Is Nothing Then
            Sheets(syf).Cells(j.Row, "B").Value = Sheets("KONTROL").Cells(i, k + 2).Value
        End If
atla:
    Next i
Next k
Set j = Nothing
MsgBox "Değiştirme gerçekleşti..!!", vbOKOnly + vbInformation, "DEĞİŞİKLİK"
End Sub

 

[mtongur]

günceldir.

 

[Korhan Ayhan]

Selamlar,

Deneme şansım olmadı ama aşağıdaki kod işinize yarayabilir. Denermisiniz.

Option Explicit
 
Sub degistir()
Dim k As Byte, i As Byte, j As Range, syf As String
For k = 3 To 15 Step 4
    For i = 9 To 33 Step 2
        If Sheets("KONTROL").Cells(i, k).Value = "" Then GoTo atla
        syf = Cells(i, k).Value
        Set j = Sheets(syf).Range("A:A").Find(Sheets("KONTROL").TextBox2.Value, , xlValues, xlWhole)
        If Not j Is Nothing Then
            Sheets(syf).Cells(j.Row, "B").Value = Sheets("KONTROL").Cells(i, k + 2).Value
            If Sheets(syf).Cells(j.Row, "B").Value <> "" And Sheets(syf).Cells(j.Row, "B").Value = 0 Then
                Sheets(syf).Rows(j.Row).Delete
            End If
        End If
atla:
    Next i
Next k
Set j = Nothing
MsgBox "Değiştirme gerçekleşti..!!", vbOKOnly + vbInformation, "DEĞİŞİKLİK"
End Sub

 

[mtongur]

Korhan Bey;
Müthişsiniz. Bu kod işe yaradı. Çok çok sağolun.
Umarım kamera olayıyla ilgili de bir kod bulabiliriz.
Allah sizden 1000 kat razı olsun.

 

[Merturk]

Sub sil_59()
'Aktif sayfada B sütununda sıfır olan satır comple siliniyor
Dim i As Long, sat As Long
sat = Cells(65536, "B").End(xlUp).Row
Application.ScreenUpdating = False
For i = sat To 1 Step -1
    If Cells(i, "B").Value <> "" And Cells(i, "B").Value _
    = 0 Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
MsgBox "B sütunda sıfır olan satır comple silindi." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

Evren Hocam, çok sağolun.