DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
ODE ile başlayanda YAT örneğinde olduğu gibi alt satırında ODE yi ilgilendiren kayıt varsa yan tarafına almak yapmak istediğim tek hücreden ayırma işlemini AYIR fonksiyonu ile yaptım bu siteden aldığım gene ama bu işlemi nasıl yapacağım konusunda dahi fikrim yok :???:Sorunuzla ilgili çalışılabilir ama nasıl bir düzen istediğiniz net değil mesela ODE ile başlıyorsa nasıl olacak? Ya da dosyanızdaki tüm veriler bu düzende mi? Mesela; "PTTMATİK'DEN YAPİLAN NAKİT YATİRMA" dışında seçenekler yok mu?
Asıl dosyanızdaki farklı örneklerin de olduğu bir örnek dosya ekleyip üzerinde de bütün ihtimallere göre elle düzenlemiş halini belirtirseniz yardımcı olacak kimse daha net yardımda bulunabilir.
B2&C2&D2& sütunlarına baksın ve burdaki değerleri kesip bir üstteki en son boş hücreden itibaren yazsın, boşalan satırıda silsin döngü bu şekilde devam etsin Karışık ama olmıcak değil gibiMETNİ SÜTUNLARA DÖNÜŞTÜR YAPINCA BOŞ KALIYOR A:A İÇİ YAT&ODE HARİCİ
Sub kod()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Cells.ClearContents
For a = 1 To s1.Range("A65500").End(3).Row
met1 = Evaluate("=TRIM(" & s1.Name & "!" & s1.Cells(a, "A").Address & ")")
met2 = Split(met1, " ")
If Left(met1, 3) = "YAT" Then
sat = sat + 1
For b = LBound(met2) To UBound(met2)
s2.Cells(sat, b + 1) = met2(b)
Next
ElseIf Left(met1, 3) = "ODE" Then
sat = sat + 1
s2.Cells(sat, "A") = met2(0)
s2.Cells(sat, "B") = met2(1)
s2.Cells(sat, "C") = met2(2)
s2.Cells(sat, "D") = met2(3) & " " & met2(4)
s2.Cells(sat, "E") = met2(5) & " " & met2(6)
Else
süt = s2.Cells(sat, "ZZ").End(1).Column + 1
If InStr(1, met1, "/") = 0 Then
s2.Cells(sat, süt) = met1
Else
s2.Cells(sat, süt) = Split(met1, "/")(0)
s2.Cells(sat, süt + 1) = Split(met1, "/")(1)
End If
End If
Next
End Sub
İşlerim dolayısı ile yeni bakabildim yukarıdaki kodu denedimÖrnek dosyanıza göre aşağıdaki kodu deneyiniz ancak farklı verilerde hata olacaktır.
Dosyanıza Sayfa2 adında boş bir sayfa daha ekleyip kodu çalıştırınız. Sayfa1'deki verileri Sayfa2'ye alacaktır.
Kod:Sub kod() Set s1 = Sheets("Sayfa1") Set s2 = Sheets("Sayfa2") s2.Cells.ClearContents For a = 1 To s1.Range("A65500").End(3).Row met1 = Evaluate("=TRIM(" & s1.Name & "!" & s1.Cells(a, "A").Address & ")") met2 = Split(met1, " ") If Left(met1, 3) = "YAT" Then sat = sat + 1 For b = LBound(met2) To UBound(met2) s2.Cells(sat, b + 1) = met2(b) Next ElseIf Left(met1, 3) = "ODE" Then sat = sat + 1 s2.Cells(sat, "A") = met2(0) s2.Cells(sat, "B") = met2(1) s2.Cells(sat, "C") = met2(2) s2.Cells(sat, "D") = met2(3) & " " & met2(4) s2.Cells(sat, "E") = met2(5) & " " & met2(6) Else süt = s2.Cells(sat, "ZZ").End(1).Column + 1 If InStr(1, met1, "/") = 0 Then s2.Cells(sat, süt) = met1 Else s2.Cells(sat, süt) = Split(met1, "/")(0) s2.Cells(sat, süt + 1) = Split(met1, "/")(1) End If End If Next End Sub
süt = s2.Cells(sat, "ZZ").End(1).Column + 1