Çözüldü Excel VBA X Hücre Boş İse Y ve X Hücre Sil

[ridvanucok]

Merhaba,

Konu başlığında da belirttiğim gibi, makro ile B,E,H,K sütunlarındaki hücreler boş ise, boş olan hücrenin karşılığı yani ( B17 boş ise, A17'yi) silmesi gerekmektedir. Hücreleri sildiğinde, alttındaki değerler dolu ise hücreleri üst hücreye kaydırmalıdır. Denemeler yaptım fakat başarısız oldum. Konu hakkında yardımlarınızı rica ederim.

 

[turist]

Sayın, @ridvanucok ,
Örnek dosyanızda;
B17 boş, A17 deki "c" silinerek, A18:A25 de yazanlar "A17:a24" aralığına mı taşınacak?
B sütununda arada örnek B7 boşsa nasıl bir düzenleme oacak?
Cevaplarsanız, çözüme yardımcı olur.
İyi çalışmalar.

 

[ridvanucok]

Sayın, @ridvanucok ,
Örnek dosyanızda;
B17 boş, A17 deki "c" silinerek, A18:A25 de yazanlar "A17:a24" aralığına mı taşınacak?
B sütununda arada örnek B7 boşsa nasıl bir düzenleme oacak?
Cevaplarsanız, çözüme yardımcı olur.
İyi çalışmalar.

Üstadım merhaba,

B17 boş ise, A17 ve B17 hücreleri silinerek, "A17:A24" hücre aralığına taşınacak fakat, B18'de boş ise, bu kuralı bir alttaki hücreye yansıtarak, B25'e kadar kontrol edecek. Burada yapmak istediğim, B, E, H, K sütunlarında boş olan hücreleri ve çerçeveleri kaldırmak. Konu hakkında yardımlarınızı rica ederim.

Saygılarımla, iyi çalışmalar.

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodlar işinizi görüyor mu?

Sub BosSil()
    Dim Satir As Long
    Dim Sutun As Integer
    For Sutun = 1 To 11 Step 3
        Satir = 2
        Do
            Satir = Satir + 1
            If Cells(Satir, Sutun + 1).Value = "" And Cells(Satir, Sutun).Value <> "" Then
                Cells(Satir, Sutun).Delete Shift:=xlUp
                Cells(Satir, Sutun + 1).Delete Shift:=xlUp
                Satir = Satir - 1
            ElseIf Cells(Satir, Sutun).Value = "" Then
                Exit Do
            End If
        Loop
    Next
End Sub

 

[ridvanucok]

Merhaba.
Aşağıdaki kodlar işinizi görüyor mu?

Sub BosSil()
    Dim Satir As Long
    Dim Sutun As Integer
    For Sutun = 1 To 11 Step 3
        Satir = 2
        Do
            Satir = Satir + 1
            If Cells(Satir, Sutun + 1).Value = "" And Cells(Satir, Sutun).Value <> "" Then
                Cells(Satir, Sutun).Delete Shift:=xlUp
                Cells(Satir, Sutun + 1).Delete Shift:=xlUp
                Satir = Satir - 1
            ElseIf Cells(Satir, Sutun).Value = "" Then
                Exit Do
            End If
        Loop
    Next
End Sub

Üstadım,

İlginiz için çok teşekkür ederim. Kod tam olarak işimi gördü. İyi çalışmalar dilerim.

 

[Muzaffer Ali]

Rica ederim. İyi çalışmalar.
Kod aşağıdaki gibi daha kısa yazılabiliyor.

Sub BosSil()
    Dim Satir As Long
    Dim Sutun As Integer
    For Sutun = 1 To 11 Step 3
        Satir = 2
        Do
            Satir = Satir + 1
            If Cells(Satir, Sutun + 1).Value = "" And Cells(Satir, Sutun).Value <> "" Then
                Cells(Satir, Sutun).Delete Shift:=xlUp
                Cells(Satir, Sutun + 1).Delete Shift:=xlUp
                Satir = Satir - 1
            End If
        Loop Until Cells(Satir, Sutun).Value = ""
    Next
End Sub