• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

hücrenin içinde belli bir alanı kopyalama

O

orcunerkek54

Katılım
18 Aralık 2005
Mesajlar
464
Excel Vers. ve Dili
ofis2003
iyi akşamlar. sayfa1de A1in içindeki yazının 8. karakterindensonra 20. karaktere kadar boşluklar dahil kopyalamak ve sayfa2 de c2den başlayarak yanyana paıştırsın 2. işlemi altına kaydederek devam etsin.
yardımcı olursanız sevinirim.
 
Selamlar,

Aşağıdaki kodu denermisiniz.

Kod: 
Sub KELİME_AYIR_LİSTELE()
    Satır = 2
    For X = 3 To [A65536].End(3).Row
    If Not IsEmpty(Cells(X, 1)) Then
    For Y = 1 To Len(Cells(X, 1))
    If Cells(X, 1).Characters(Start:=Y, Length:=1).Font.ColorIndex = 3 Then
    İLK = Y
    GoTo Devam1
    End If
    Next
Devam1:
    For Z = Y To Len(Cells(X, 1))
    If Cells(X, 1).Characters(Start:=Z, Length:=1).Font.ColorIndex = xlAutomatic And Not IsEmpty(Cells(X, 1).Characters(Start:=Z, Length:=1)) Then
    SON = Z + 1
    GoTo Devam2
    End If
    Next
Devam2:
    Sheets("Sayfa2").Cells(Satır, 3) = Mid(Cells(X, 1), İLK, SON - İLK)
    Sheets("Sayfa2").Cells(Satır, 3).Font.ColorIndex = 3
    Satır = Satır + 1
    End If
    Next
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
[COLOR=blue]'KODUN AÇIKLAMALARI[/COLOR]
[COLOR=blue]'1. Satır - Makromuza isim veriyoruz.[/COLOR]
[COLOR=blue]'2. Satır - Satır değerini 2 olarak tanımlıyoruz.[/COLOR]
[COLOR=blue]'3. Satır - X adında bir döngü başlatıyoruz. Bu döngü satır sayısı kadar devam edecek şekilde ayarlanmıştır.[/COLOR]
[COLOR=blue]'4. Satır - Döngüye aldığımız hücrenin boş olup olmadığını sorguluyoruz.[/COLOR]
[COLOR=blue]'5. Satır - Y adında bir döngü başlatıyoruz. Bu döngü satırdaki kelimenin karakter sayısı kadar devam edecek şekilde ayarlanmıştır.[/COLOR]
[COLOR=blue]'6. Satır - Hücre içindeki karakterlerin yazı renginin kırmızı olup olmadığını kontrol ediyoruz.[/COLOR]
[COLOR=blue]'7. Satır - Eğer karakter rengi kırmızı ise İLK parametresinin Y değerine eşitliyoruz.[/COLOR]
[COLOR=blue]'8. Satır - Şartımız sağlandığı için ve döngüden çıkmak için Devam1 satırına yönlendiriyoruz.[/COLOR]
[COLOR=blue]'9. Satır - 6. satırdaki sorgumuzu sonlandırıyoruz.[/COLOR]
[COLOR=blue]'10. Satır - Y döngüsüne devam ediyoruz.[/COLOR]
[COLOR=blue]'11. Satır - Devam1 bloğunu belrliyoruz.[/COLOR]
[COLOR=blue]'12. Satır - Z adında bir döngü başlatıyoruz. Bu döngü satırdaki Y döngüsünde tesbit edilen ilk kırmızı renkli karakterden sonraki karakterleri kontrol edecek şekilde ayarlanmıştır.[/COLOR]
[COLOR=blue]'13. Satır - Eğer karakter rengi siyah (otomatik) ise ve karakter boşluk değilse sorgusunu soruyoruz.[/COLOR]
[COLOR=blue]'14. Satır - Şartımız sağlandığı için SON parametresinin Z+1 değerine eşitliyoruz.[/COLOR]
[COLOR=blue]'15. Satır - Şartımız sağlandığı için ve döngüden çıkmak için Devam2 satırına yönlendiriyoruz.[/COLOR]
[COLOR=blue]'16. Satır - 13. satırdaki sorgumuzu sonlandırıyoruz.[/COLOR]
[COLOR=blue]'17. Satır - Z döngüsüne devam ediyoruz.[/COLOR]
[COLOR=blue]'18. Satır - Devam2 bloğunu belrliyoruz.[/COLOR]
[COLOR=blue]'19. Satır - İLK ve SON değerleri belli olduğu için 2. satırdan itibaren değerleri aktarıyoruz.[/COLOR]
[COLOR=blue]'20. Satır - Aktarılan değerin renginide aktarıyoruz.[/COLOR]
[COLOR=blue]'21. Satır - Satır değerini 1 arttırıyoruz.[/COLOR]
[COLOR=blue]'22. Satır - 4. satırdaki sorgumuzu sonlandırıyoruz.[/COLOR]
[COLOR=blue]'23. Satır - X döngüsüne devam ediyoruz.[/COLOR]
[COLOR=blue]'24. Satır - İşlemin tamamlandığına dair kullanıcıya bilgi mesajı veriyoruz.[/COLOR]
[COLOR=blue]'25. Satır - Makromuzu sonlandırıyoruz.[/COLOR]
 
ilginiz için teşekkürler. kodlarınız çalışıyor verileri alt alta değildi yan yana kaydedebilirmi ve içinci butona basışımda bir alt satıca 2. veriyi kaydetsin yani kaydı alta devam etsin. elinize sağlık çok güzel olmuş ancak kodları kısaltmanız mümkünmü. ekteki dosyamda açıklama yaptım bakabilirseniz sevinirim
 
Selamlar,

Kod yazmanın mantığı mümkün olduğunca kısa yazılarak işlemi tamamlamaktır. Eğer verileriniz 50.000 satır olsaydı sizin dediğiniz mantığa göre 50.000 satır kod yazmak gerekecektir. Bu mantıksız bir işlemdir.

Eğer siz hangi satırda ne aranacak belirtirseniz çözümü ona göre üretebiliriz.
 
sorumu tam olarak anlatamadım galiba.sorumu şu şekilde değiştirmek istiyorum. sayfa1 deki A1 hücresinin içindeki yazılı metinin sadece 10. karakterinden 20. karakterine kadar olan kısmı kopyalayıp sayfa2de A2ye yapıştırsın bir sonraki kayıt işleminide onun altına devam ettirsin. alt alta kayıt yapsın. teşekkürler.
 
Selamlar,

Aşağıdaki kodu denermisiniz.

Kod: 
Sub KELİME_AYIR_LİSTELE()
    Sheets("Sayfa2").Range("C2:C65536").ClearContents
    Satır = 2
    For X = 3 To [A65536].End(3).Row
    If Not IsEmpty(Cells(X, 1)) Then
    Sheets("Sayfa2").Cells(Satır, 3) = Mid(Cells(X, 1), 10, 10)
    Satır = Satır + 1
    End If
    Next
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
syn Korhan Ayhan ilginiz için teşekkürler. bu kodunuzu sadece sayfa1 deki a2 hücresi için değiştirebilirmiyiz. sizin kodunuz a-sütununu tamamen kapsıyor. bazı yerleri değiştirdim ama tutturamadım.
 
Selamlar,

Aşağıdaki kodu denermisiniz.

Kod: 
[LEFT]Sub KELİME_AYIR_LİSTELE()
 Satır = Sheets("Sayfa2").Range("C65536").End(3).Row+1
 If Not IsEmpty([A2]) Then
 Sheets("Sayfa2").Cells(Satır, 3) = Mid([A2], 10, 10)
 End If
 MsgBox "İşleminiz tamamlanmıştır.", vbInformation[/LEFT]
End Sub
 
Son düzenleme:
Sheets("Sayfa2").Cells(Satır, 3) = Mid(Cells(X, 1), 10, 10)
run time error 1004 diye hata verdi.
 
Selamlar,

Gerekli düzeltmeyi yaptım tekrar denermisiniz.
 
Korhan Bey teşekkürler
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst