Belli bir sıralamaya uymayanı bulma ve silme

[alicimri]

#9 mesajdaki kod tamda sizin istediğiniz sonucu veriyor.

 

[veyselemre]

Sub test()
    Dim veri, i, say
    veri = Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).Value
    say = 0
    For i = 1 To UBound(veri) - 1
        If WorksheetFunction.IsText(veri(i, 1)) And WorksheetFunction.IsNumber(veri(i + 1, 1)) Then
            say = say + 2
            veri(say - 1, 1) = veri(i, 1)
            veri(say, 1) = veri(i + 1, 1)
            i = i + 1
        End If
    Next i
    Range("B1:B" & Rows.Count).ClearContents
    Range("B1").Resize(say).Value = veri
End Sub

 

[Emrah33]

#9 mesajdaki kod tamda sizin istediğiniz sonucu veriyor.

Bir daha denedim hocam A1metin A2sayı A3 sayı olarak ilerlediği zaman ikinci sayıyı alıyor. Metin kendinden sonra gelen sayıyı alması gerekiyor

 

[Emrah33]

Sub test()
    Dim veri, i, say
    veri = Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).Value
    say = 0
    For i = 1 To UBound(veri) - 1
        If WorksheetFunction.IsText(veri(i, 1)) And WorksheetFunction.IsNumber(veri(i + 1, 1)) Then
            say = say + 2
            veri(say - 1, 1) = veri(i, 1)
            veri(say, 1) = veri(i + 1, 1)
            i = i + 1
        End If
    Next i
    Range("B1:B" & Rows.Count).ClearContents
    Range("B1").Resize(say).Value = veri
End Sub

Hocam simdi denedim, metin ve kendinden hemen sonra gelen sayıyı alıyor orası güzel çalıştı ama;
1- B sütununa yazdı
2- bağlı satırları almadı
3- diğerlerini silmedi
yine de çok ama çok teşekkür ederim değerli zamanınızı ayırdığınız için.

 

[alicimri]

#9 mesajdaki kodlarda

Rows(x - 1).Delete

satırını

Rows(x ).Delete

olarak değiştirin.

 

[Emrah33]

Automation Error
Özel bir durum oluştu
hatası alıyorum Ali Bey

 

[alicimri]

Çalışan bir kod dediğim değişikliği yapınca o hatayı vermez
#9 mesaj üzerinde değişikliği yaptım tekrar kopyalayıp yapıştırın.

 

[Emrah33]

Şimdi tekrar tekrar bir çok kez denedim hata vermedi ve harika çalışıyor. Elinize emeğinize sağlık iyi ki varsınız