A1 hücresinden 2 farklı veriyi alarak birleştirmek

[huseyinvurkan]

Merhaba A1 hücresinde bulunan 1. Sınıf / A Şubesi
şeklindeki veriyi B1 hücresine 1A halinde nasıl yazdırabiliriz acaba? Teşekkürler.

 

[Korhan Ayhan]

Deneyiniz.

=YERİNEKOY(YERİNEKOY(A1;". Sınıf / ";"");" Şubesi";"")

=SOLDAN(A1;BUL(".";A1)-1)&PARÇAAL(A1;BUL(" / ";A1)+3;1)

 

[huseyinvurkan]

Sayın KORHAN AYHAN teşekkür ederim. Bu formülü bir makroya dönüştürmeye çalıştım. olmadı. Daha önce öğrendiğim bir makroyu değiştirdim. ama olmadı. Ne yapabilirim. Teşekkürler.

http://s5.dosya.tc/server/grumgo/SINIF_SUBE_SAYISI.xls.html

 

[Korhan Ayhan]

Aşağıdaki kodu kullanabilirsiniz.

Sub Makro()
    MsgBox Replace(Replace(Range("A1").Value, ". Sınıf / ", ""), " Şubesi", "")
End Sub

 

[huseyinvurkan]

Bu satırı kullandığım makroya nasıl eklerim üstteki linkteki dosyama uygun bir makro nasıl olabilir? Teşekkürler

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Son As Long, Satir As Long
    
    Application.ScreenUpdating = False

    Set S1 = Sheets("LİSTE")
    Set S2 = Sheets("SINIF")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    S2.Range("A2:B" & S2.Rows.Count).ClearContents
    Satir = 2
    
    For X = 2 To Son
        If InStr(1, S1.Cells(X, 1), "Sınıf") > 0 Then
            S2.Cells(Satir, 1) = Replace(Replace(Replace(S1.Cells(X, 1).Value, ". Sınıf / ", ""), " Şubesi", ""), ". Sınıf-Hafif Zihinsel / ", "")
            S2.Cells(Satir, 2) = S1.Cells(X, "J")
            Satir = Satir + 1
        End If
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[huseyinvurkan]

Sayın Korhan Ayhan Kod gayet güzel çalıştı. Elinize sağlık ancak son satırdaki
4. Sınıf-Hafif Zihinsel / A Şubesi Aktarılırken 4A olarak aktarılıyor. Yani listede 2 tane 4A sınıfı oluyor. Bu kodu daha önceki bir çalışmamda kullanacağım için 4A yerine Zihinsel kelimesinin Z harfini alarak 4Z gibi oluşturulabilir mi? Teşekkürler.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Son As Long, Satir As Long
    
    Application.ScreenUpdating = False

    Set S1 = Sheets("LİSTE")
    Set S2 = Sheets("SINIF")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    S2.Range("A2:B" & S2.Rows.Count).ClearContents
    Satir = 2
    
    For X = 2 To Son
        If InStr(1, S1.Cells(X, 1), "Sınıf") > 0 Then
            If InStr(1, S1.Cells(X, 1), "Zihinsel") > 0 Then
                S2.Cells(Satir, 1) = Left(S1.Cells(X, 1).Value, 1) & "Z"
            Else
                S2.Cells(Satir, 1) = Replace(Replace(S1.Cells(X, 1).Value, ". Sınıf / ", ""), " Şubesi", "")
            End If
            S2.Cells(Satir, 2) = S1.Cells(X, "J")
            Satir = Satir + 1
        End If
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[huseyinvurkan]

Sayın Korhan Ayhan tam istediğim gibi olmuş teşekkürler