Hücredeki Küçük Harfi Bulma

[Allback]

Merhaba,

Hücrelerin içindeki metinde, bazılarının tümü büyük bazılarının sadece baş harfi büyük olarak yazılmış metinler var.
Metindeki büyük harfle yazılanlar makine adlarını, sadece baş harfi büyük yazılanlar arızaları gösteriyor.
Ben bu hücreden makine ve arıza çeşitlerini ayırmak istiyorum.
İlk küçük harfi bulabilsem ayıracağım ama bununla ilgili bir formül bulamadım.
"PLASTİK KUMLAMA MAKİNESİ Basınçlı Hortum Hava Kaçağı" örnek hücre içeriği bu şekilde... "PLASTİK KUMLAMA MAKİNESİ" ile "Basınçlı Hortum Hava Kaçağı" kısmını nasıl ayırabilirim?

 

[Allback]

Kendi soruma cevap yazayım. Şöyle bir çözüm buldum. Belki yolu çok uzatmış olabilirim ama ihtiyacı olanlar faydalanabilsin diye paylaşıyorum.
Öncelikle ilk küçük harfi bulmak için Chatgpt'ye bir tane kod yazdırdım. Bu kodu kullanmak için boş hücreye =İlkKüçükHarfKonum(aranan hücre) yazıp aradığım hücredeki ilk küçük harfin kaçıncı karakter olduğunu buldum. Sonuna "-3" ekleyerek bir önceki büyük harf ve boşluktan öncesinin kaç karakter olduğunu hesapladım. Sonrası soldan formülü ile makine adını aldım.

Function İlkKüçükHarfKonum(Metin As String) As Integer
Dim i As Integer
For i = 1 To Len(Metin)
If Mid(Metin, i, 1) = LCase(Mid(Metin, i, 1)) And Mid(Metin, i, 1) Like "[a-z]" Then
İlkKüçükHarfKonum = i
Exit Function
End If
Next i
İlkKüçükHarfKonum = -1 ' Küçük harf bulunamadıysa -1 döndür
End Function

Daha sonra uzunluk formülü ile hücredeki metnin toplam uzunluğunu aldım. toplam uzunluktan, ilkküçükharfkonum formülü ile bulduğum değeri çıkardım. kalan değerden de başındaki boşluğu silmek için -1 ekledim.

Çıkan sayısal değer ile sağdan formülü ile arıza adını aldım.

Daha kolay bir yolu vardır belki ama ben bu şekilde çözdüm.

 

[zpawnz]

Merhaba,

Sub ExtractCase()
Dim i As Long
Dim upper As String
Dim lower As String
For i = 1 To 100
upper = ""
lower = ""
For j = 1 To Len(Cells(i, 1).Value)
If Asc(Mid(Cells(i, 1).Value, j, 1)) >= 65 And Asc(Mid(Cells(i, 1).Value, j, 1)) <= 90 Then
upper = upper & Mid(Cells(i, 1).Value, j, 1)
ElseIf Asc(Mid(Cells(i, 1).Value, j, 1)) >= 97 And Asc(Mid(Cells(i, 1).Value, j, 1)) <= 122 Then
lower = lower & Mid(Cells(i, 1).Value, j, 1)
Else
upper = upper & Mid(Cells(i, 1).Value, j, 1)
lower = lower & Mid(Cells(i, 1).Value, j, 1)
End If
Next j
Cells(i, 2).Value = Application.WorksheetFunction.Trim(upper)
Cells(i, 3).Value = Application.WorksheetFunction.Trim(lower)
Next i
End Sub

Deneyiniz.

 

[Allback]

Merhaba,

Sub ExtractCase()
Dim i As Long
Dim upper As String
Dim lower As String
For i = 1 To 100
upper = ""
lower = ""
For j = 1 To Len(Cells(i, 1).Value)
If Asc(Mid(Cells(i, 1).Value, j, 1)) >= 65 And Asc(Mid(Cells(i, 1).Value, j, 1)) <= 90 Then
upper = upper & Mid(Cells(i, 1).Value, j, 1)
ElseIf Asc(Mid(Cells(i, 1).Value, j, 1)) >= 97 And Asc(Mid(Cells(i, 1).Value, j, 1)) <= 122 Then
lower = lower & Mid(Cells(i, 1).Value, j, 1)
Else
upper = upper & Mid(Cells(i, 1).Value, j, 1)
lower = lower & Mid(Cells(i, 1).Value, j, 1)
End If
Next j
Cells(i, 2).Value = Application.WorksheetFunction.Trim(upper)
Cells(i, 3).Value = Application.WorksheetFunction.Trim(lower)
Next i
End Sub

Deneyiniz.

Ayırma işlemi yaptı ama baya hatalı ayırdı.

 

[zpawnz]

Merhaba,

Sub ExtractCase()
Dim i As Long
Dim upper As String
Dim lower As String
For i = 1 To 100
upper = ""
lower = ""
Dim word As Variant
Words = Split(Cells(i, 1).Value, " ")
      For Each word In Words
        If UCase(word) = word Then
           upper = upper & word & " "
        Else
           lower = lower & word & " "
        End If
      Next word
      Cells(i, 2).Value = Application.WorksheetFunction.Trim(upper)
      Cells(i, 3).Value = Application.WorksheetFunction.Trim(lower)
   Next i
End Sub

Format ile ilgili hata olmuştur, deneyiniz.

 

[Biolightant]

Merhaba
Güzel çözmüşsün bence

"[a-z]"

Türkçe karakterler de belki problem yaşama ihtimaline karşılık
Örnek : Kırk Parçalı Boru , Çıkık Boru, İç Boru Kayıp... gibi kelimeler de

"[a-zçğıöşü]"

Function İlkKüçükHarfSonrasıMetin(Metin As String) As String
    Dim i As Integer
    For i = 1 To Len(Metin)
        ' Türkçe küçük harf kontrolü yapılıyor
        If Mid(Metin, i, 1) = LCase(Mid(Metin, i, 1)) And Mid(Metin, i, 1) Like "[a-zçğıöşü]" Then
            ' (İlk küçük harften -1) sonraki metni döndür
            İlkKüçükHarfSonrasıMetin = Mid(Metin, i - 1)
            Exit Function
        End If
    Next i
    ' Küçük harf bulunamadıysa boş bir dize döndür
    İlkKüçükHarfSonrasıMetin = ""
End Function

 

[Korhan Ayhan]

Merhaba,

Formülle alternatif...

Büyük harfli kelimeler;

=TEXTJOIN(" ";1;IF(EXACT(UPPER(TEXTSPLIT(A1;" "));TEXTSPLIT(A1;" "));TEXTSPLIT(A1;" ");""))

Küçük harfli kelimeler; (Baş harfi büyük olanlar...)

=TEXTJOIN(" ";1;IF(EXACT(PROPER(TEXTSPLIT(A1;" "));TEXTSPLIT(A1;" "));TEXTSPLIT(A1;" ");""))