Değerleri silip yukarı kaydırma

[Muhammet Okumuş]

Arkadaşlar merhaba.
Aşağıdaki kod boş hücreler için işlem yapıyor. Peki boş hücre yerine örneğin hasan yazan hücrleri silip yukarı doğru nasıl kaydırabiliriz?

Range("A1:A20").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

 

[leumruk]

Arkadaşlar merhaba.
Aşağıdaki kod boş hücreler için işlem yapıyor. Peki boş hücre yerine örneğin hasan yazan hücrleri silip yukarı doğru nasıl kaydırabiliriz?

Onu bu kod mantığıyla yapamazsınız. Bu kod mantığıyla boş hücreleri ya da dolu hücreleri ya da formül olan hücreleri vb... toplu halde silebilirsiniz. Belli bir veri için farklı bir kod mantığı kurmalısınız.

 

[Muhammet Okumuş]

teşekkür ederim sn leumruk aşağıdaki kod hiç bir öğe bulunamadı diyor.

Sub Düğme1_Tıklat()
For i = 1 To 20
If Cells(i, 1) = "hasan" Then Cells(i, 1) = ""
Range("A1:A20").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
Next i
End Sub

 

[leumruk]

Merhaba,
Önceki mesajımda kullandığınız yöntemi "hasan"da kullanamayacağınızı belirtmiştim.
Size 2 kod önereceğim. 1. kod diğerinden çok daha hızlı çalışacaktır. Kalabalık verilerde 1. kodu öneririm. Eğer veri mikterınız az ise 2. kodun kullanımı sizin için daha rahat olacaktır.
1. Kod:

Sub Veri_Sil()
Set Aralik = Range("a2:a" & [a65536].End(3).Row)
Set Bul = Aralik.Find("Hasan", LookIn:=xlValues, lookat:=xlWhole)
    If Not Bul Is Nothing Then
    Adres = Bul.Address
    Application.ScreenUpdating = False
        Do
        deg = deg & "a" & Bul.Row & ","
            Set Bul = Aralik.FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If
If deg <> "" Then
Range(Mid(deg, 1, Len(deg) - 1)).Delete shift:=xlUp
Application.ScreenUpdating = True
MsgBox "İşlem tamamlanmıştır.", vbInformation, "l e u m r u k"
End If
End Sub

2. Kod:

Sub Veri_Sil2()
Application.ScreenUpdating = False
For x = [a65536].End(3).Row To 1 Step -1
If UCase(Cells(x, "a")) = UCase("Hasan") Then
Cells(x, "a").Delete shift:=xlUp
End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlanmıştır.", vbInformation, "l e u m r u k"
End Sub

 

[Muhammet Okumuş]

Sn leumruk çok teşekkür ederim. Bunu da arşivime ekleyeceğim. Aslında kod bölümüne Range("A1"). yazınca açılan kutudaki fonksiyonların ne işe yaradığını bilsem, ben bu makroyu çözeceğim.

 

[leumruk]

Sn leumruk çok teşekkür ederim. Bunu da arşivime ekleyeceğim. Aslında kod bölümüne Range("A1"). yazınca açılan kutudaki fonksiyonların ne işe yaradığını bilsem, ben bu makroyu çözeceğim.

Eğer Range("a1"). yazınca çıkanların ne olduğunu öğrenirseniz bırakın makroyu çözmeyi, bu işin "Ordinaryus"u olursunuz. Biz de sıraya dizilir ellerinden öperiz.

 

[Muhammet Okumuş]

sn leumruk saydım 175 civarı fonksiyon var.hadi ben bunların 15-20 tanesini bilsem 150 fonksiyon kalıyor. çok aradım ama bulamadım.gerçi onların adları ne olarak geçiyor bilmiyorum.excel kod fonksiyonları diye aratıyorum.elimde ing. kaynaklar var ama pek işime yaramıyor.

 

[Muhammet Okumuş]

Range("A1:e20").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

Bu kod boş hücreleri silip yukarı doğru kaydırıyor. Peki sağa yada sola kaydıran kod nasıl olur?

 

[Seyit Tiken]

Sub Makro1()
[A:A].Copy [B1]: [A:A] = ""
End Sub

 

[Muhammet Okumuş]

Sn Seyit Tiken teşekkür ederim ancak benim aradığım çözüm bu değildi.
Range("A1:e20").SpecialCells(xlCellTypeBlanks).Del ete Shift:=xlToLeft olacakmış.