Soru Son boşluktan sonrasını at VBA

[leonadies]

Merhaba üstadlar;

Araştırmalar yaptım ancak son boşluktan sonrasını atmayı bulamadım.

"HAZIR 29.06.2021 15:34:05"

Bu örneği ;

"HAZIR 29.06.2021"

Şeklinde almak istiyorum. Ancak formül değil makro gerekmekte. Kalıplar hep aynı ama ilk kelimeler değişebiliyor. Bekliyor, gelecek, geldi vb...

 

[Orion1]

Buyurun.

Sub ornek()
Dim deg As String
deg = Split(Range("A1"), " ")(0)
deg1 = deg & " " & Split(Range("A1"), " ")(1)
MsgBox deg1
End Sub

 

[Korhan Ayhan]

Alternatif;

Option Explicit

Sub Test()
    Dim Veri As Variant
    Veri = Split("HAZIR 29.06.2021 15:34:05", " ")
    ReDim Preserve Veri(0 To UBound(Veri) - 1)
    MsgBox Join(Veri, " ")
End Sub

 

[Muzaffer Ali]

Merhaba.

Şöyle bir fonksiyon hazırladım. Alternatif olsun.

Function YeniMetin(Metin As String) As String
    Dim Bol As Variant
    Dim Bak As Integer
    Bol = Split(Metin, " ")
    For Bak = 0 To UBound(Bol) - 1
        If YeniMetin = "" Then
            YeniMetin = Bol(Bak)
        Else
            YeniMetin = YeniMetin & " " & Bol(Bak)
        End If
    Next
End Function

 

[leonadies]

Herkese teşekkür ederim

Veriler A:A da olmak üzere
Döngü ile çözüm gerekirse B:B sütununda nasıl çözümleriz?

 

[Orion1]

Herkese teşekkür ederim

Veriler A:A da olmak üzere
Döngü ile çözüm gerekirse B:B sütununda nasıl çözümleriz?

Benim verdiğim örnek A sütununda.
For next döngüsü yaparak işi çözebilirsiniz.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Metindeki_Son_Kelimeyi_Sil()
    Dim Veri As Variant, Son As Long, Say As Long
    Dim X As Long, Kelime As Variant, Zaman As Double
    
    Zaman = Timer
    
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son < 2 Then Son = 2
    
    Veri = Range("A1:A" & Son).Value
    
    Range("B:B").Clear
    
    ReDim Liste(1 To UBound(Veri), 1 To 1)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If InStr(1, Veri(X, 1), " ") > 0 Then
            Kelime = Split(Veri(X, 1), " ")
            ReDim Preserve Kelime(0 To UBound(Kelime) - 1)
            Say = Say + 1
            Liste(Say, 1) = Join(Kelime, " ")
        Else
            Say = Say + 1
            Liste(Say, 1) = Veri(X, 1)
        End If
    Next
    
    If Say > 0 Then
        Range("B1").Resize(Say) = Liste
        MsgBox "İşleminiz tamamlanmıştır." & vbCr & vbCr & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        MsgBox "Uygun kayıt bulunamadı!", vbExclamation
    End If
End Sub