• DİKKAT

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

hücredeki metnin baştan belli bir kısmı sondan bir kısmını atmak

M

mypostahane

Katılım
26 Ocak 2009
Mesajlar
25
Excel Vers. ve Dili
2010 türkçe
Değerli Üyeler
Bir proğramdan veri alıyorum ancak tüm bilgileri tek bir hücre verisi olarak alıyor doğal olarak onbin onbeşbin karakterlik tek hücrelik verilerim oldu her satırda (nur topu gibi)

Sorum Şu :

Bir hücrede ki metnin şu kelimeye kadar olan kısmını at, şu kelimeden sonraki kısmını at

diyen bir koda ihtiyacım var bir türlü halledemedim. Yardımcı olursanız minnettar olurum. Zaman ayıracak tüm arkadaşlara şimdiden teşekkür ediyorum
 
A1'de

Kod: 
Bir hücrede ki metnin şu kelimeye kadar olan kısmını at, şu kelimeden sonraki kısmını at
yazıyorken, B1'e aşağıdaki formülü yazdığımda :

Kod: 
=SOLDAN(A1;BUL("kelimeye";A1)-1)&SAĞDAN(A1;UZUNLUK(A1)-BUL("kelimeden";A1)+1)
sonuç

Kod: 
Bir hücrede ki metnin şu kelimeden sonraki kısmını at

oluyor.

Formül A1'de "kelimeye" kadar olan kısım ile "kelimeden" itibaren olan kısmı alıp birleştiriyor.
 
=SOLDAN(A1;BUL("kelimeye";A1)-1)&SAĞDAN(A1;UZUNLUK(A1)-BUL("kelimeden";A1)+1)

Teşekkür ederim ilginiz için, bunu VB kodu olarak da aynı mı yazıyoruz.
 
Bu şekilde değil. Makroyu tam istediğiniz gibi yapabilmek için kriterleri daha net bir şekilde belirlemelisiniz. Yani işlem hangi hücrelerde yapılacak, hangi kriterlere göre çalışacak ve sonuçlar ne yapılacak? gibi sorulara göre makro kodu değişebilir.
 
veriler A sütununda A1, A2, A3... gibi gidiyor
Burda verilerin gereksiz kısımlarını atarak ihtiyaç kadar olan kısmını tutmak istiyorum. Yani bulunduğu yerde gereksiz kısımları atılacak ama farklı bir çözümde olabilir b sütununa gereksiz kısımları atılmış halini kopyalayıp burayı baz alarak işlem tesis edebiliriz de. Makronun geri kalan kısmını ben hallederim sanıyorum bana sadece yukardaki cevabınızda verdiğiniz formülün VB yazılışı gerekiyor.
 
Aşağıdaki kodları çalıştırdığınızda öncelikle ilk ve son kelimeleri sorar, daha sonra A sütunundaki tüm dolu hücreleri teker teker kontrol eder ve verdiğiniz iki kelimeye göre öncesini ve sonrasını alarak yine A sütununa yazar:

Kod: 
Sub KONTROL()
ilk = InputBox("İlk kelimeyi giriniz (Bu kelimeye kadar olan kısım alınacaktır")
son = InputBox("Son kelimeyi giriniz (Bu kelimeden itibaren olan kısım alınacaktır")
listesonu = Cells(Rows.Count, "A").End(3).Row
On Error Resume Next
For i = 1 To listesonu
    If Cells(i, "A") <> "" And Len(Cells(i, "A")) <> Len(Replace(Cells(i, "A"), ilk, "")) And _
    Len(Cells(i, "A")) <> Len(Replace(Cells(i, "A"), son, "")) Then
        a = Left(Cells(i, "A"), WorksheetFunction.Find(ilk, Cells(i, "A")) - 1)
        b = Right(Cells(i, "A"), Len(Cells(i, "A")) - WorksheetFunction.Find(son, Cells(i, "A")) + 1)
        
        Cells(i, "A") = a & b
        a = ""
        b = ""
        
    End If
Next

End Sub
 
Sayın YUSUF44 çok teşekkür ediyorum ilginize gönderdiğiniz kodlar çok güzel ama farkettim ki ben derdimi anlatamamışım tam olarak;

A1 hücresinin orjinal metni :

( gereksiz hikaleyer kısmı uzunluk değişken ÖZETLE asıl lazım olan metin o da değişken NİHAYET ve yine ihtiyaç olmayan detaylar )

İşlemden sonra almasını istediğim hal :

( asıl lazım olan metin o da değişken )

Yani ÖZETLE kelimesinden önceki kısımlar lazım olmayacak atılacak ve NİHAYET kelimesinden sonraki kısım da lazım olmayacak atılacak bana kalan kısım gerekli bunu A1 hücresindeki veriye A1 hücresinde uygulamak istiyorum. Oradaki metnin başını ve sonunu kırpıp muhafaza edecek. Bu arada "ÖZETLE" ve "NİHAYET" değişken değil her satırda metnin icinde sabit var. Sizi derdimi tam anlatamayarak yorduğum için özür diliyorum.
 
Benim 4. mesajımda anlatmak istediğim de tam olarak buydu aslında. Sonuçta sizin sorunuzu ve ihtiyacınızı siz çok iyi biliyorsunuz ama biz sadece sizin anlattığınız kadarını biliyoruz.

Verdiğiniz son bilgilere göre aşağıdaki kodları deneyiniz:
Kod: 
Sub KIRP()
ilk = InputBox("İlk kelimeyi giriniz (Bu kelimeden sonraki kısım alınacaktır)")
son = InputBox("Son kelimeyi giriniz (Bu kelimeye kadar olan kısım alınacaktır)")
listesonu = Cells(Rows.Count, "A").End(3).Row
On Error Resume Next
For i = 1 To listesonu
    If Cells(i, "A") <> "" And Len(Cells(i, "A")) <> Len(Replace(Cells(i, "A"), ilk, "")) And _
    Len(Cells(i, "A")) <> Len(Replace(Cells(i, "A"), son, "")) Then
    k1 = WorksheetFunction.Find(ilk, Cells(i, "A")) + Len(ilk)
    k2 = WorksheetFunction.Find(son, Cells(i, "A"))
    k3 = k2 - k1
    
        veri = Mid(Cells(i, "A"), k1, k3)
       
        
        Cells(i, "A") = Trim(veri)
        k1 = ""
        k2 = ""
        k3 = ""
        veri = ""
    End If
Next

End Sub


Son olarak bu sorudaki tecrübenizden yola çıkarak bundan sonraki olası sorularınızda ihtiyacınızı daha iyi anlatmanız çözüme ulaşmanızı kolaylaştıracaktır. İyi çalışmalar.
 
Teşekkür ediyorum istediğim tam olarak buydu. Yardımlarınız için çok teşekkür ederim.
 
Bir sorunum daha ortaya çıktı. Bu listeyi istediğim gibi düzenledikten sonra bir usarform kullanarak textboxa girilen veriyi süzme kriteri alıp hücrelerdeki bu metinler içnde

"ahmet" geçenleri süzüp sonuçları yeni bir sayfaya kopyalayıp sayfa adı olarak süzme kriteri ni yani "ahmet" kullanıyorum.
"Mehmet" geçenleri süzüp sonuçları yeni bir sayfaya kopyalayıp sayfa adı olarak süzme kriteri ni yani "Mehmet" kullanıyorum.

Bu noktada ;
1- textbox boş iken arama yapmak isterse "boş arama yapılmaz" diyip başa dönecek
2- daha önce aynı arama yapılmış ise (yani sayfa isimlerini kontrol edip daha önce varsa) "bu isimde sayfa var" diyip başa dönecek
bu kontrolleri geçerse arama yapıp yukarda anlattığım gibi yeni sayfaya kopyalayacak ve bu saonuçları veri sayfasından yani sorgulamayı yaptığı listeden kaldıracak orda artık yer tutmasına gerek kalmadığı için ordan kaldıracak.

Bunu normalde süz işlemi ile yapıyorum verileri de yeni sayfaya kopyalıyorum bir sorun yok ama BOŞ ARAMA ve DAHA ÖNCE OLAN arama işinde ki kontrolleri bir türlü oturtamadım. Yardımcı olabilirmisiniz?
 
İşin içine userform ve textbox girince beni aşıyor maalesef.
 
Seni aşmayacağından eminim


if SAYFALARIN İSİMLERİ = i then
...... diyeceğimiz formülde altı çizili yerin söz dizilimini yapamadım. Tabi bu arada bu çalışma kitabında çok sayıda (onlarca, yüzlerce ) sayfa olabilir, tüm sayfa adlarını kapsayan formülü kastediyorum.
 
For a = 1 to sheets.count
if sheets(a).name = i then

burdaki i nerden geliyor anlamadım.
 
Sevgili YUSUF44 teşekkür ediyorum bu kod işimi gördü. Ayrıca "i" bir değişken tektbox girdisi süz kriteri olarak kullandığım, aynı zamanda sayfa adı olarak kullandığım değişken. Sayfa adlarını o yüzden onunla kıyaslayıp daha önce verilmiş ise kontrol edip bilgi versin diye. Her şey için çok teşekkür ederim. Son bir soru:
Makro
Süz kriteri olarak aldığım ismi kullanıp süz yapıyor sonra satırları sayıp işaretliyor kopyalıyor yeni bir sayfaya yapıştırıp sayfa adını arama kriterinde kullandığı isim yapıyor, arama yaptığı listeden bu verileri çıkartıyor, ve yeni bir işlem için başa dönüp bitiyor.

Burda birinci sorunum isim sayfa isimleriyle örtüşüyorsa hata mesajı çıkartıyordum ama mesajdan sonra işlemi iptel edip başa gidip durması gerekirken hata mesajından sonra her şey normalmiş gibi devam edip diğer işlemleri yapması. Bir türlü engelleyemeyince değişkenin değerini boş atayıp bir sonraki boş arama prosedürünü işletmek gibi bir çözüm buldum. Boş arama hata mesajından sonra işlemi sonlandırıyor ama neden se var olan isim prosedürü işleme devam ediyor. Belki mantıklı olan iki kontrolü bir arada yaptırmak ama onu da yazamadım gramer bilgim yetmedi.

Bir diğeri sorun ise; ya yazdığım isim yoksa onu nasıl algılatacağız benim kodlarımda onu algılamıyor. sanki varmış gibi işlemlerin hepsini yapıyor ve sayfa açıyor ... Kodlar aşağıda verdiğim halde

'değişkenleri atıyoruz
sembol1 = TextBox1.Text
kapsama = Cells(1, "A").End(xlDown).Row
' Sembol1 değişkeni hem arama kriteri hem sayfa adı olarak kullanılacağı için sayfa adlarını taratıp daha önce aranmışmı yani sayfa açılmışmı bakıyoruz.
For a = 1 To Sheets.Count
If Sheets(a).Name = sembol1 Then
sembol1 = ""

End If
Next

'Arama kriteri verilmeden arama yapmaya kalkarsa yani boş arama yaparsa hata vermesin diye uyarıyoruz
If sembol1 = Empty Then
acıklama = " Boş Arama veya Daha Önceden Yapılmış Bir Arama Yapamazsınız"
buton = vbOKOnly + vbInformation + vbDefaultButton1
baslık = "Hooop Dedik!"
MsgBox acıklama, buton, baslık
TextBox1.SetFocus
TextBox1.Text = ""

Else: GoTo pas
pas:

' şimdi istenilen verileri süzelim

Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:="=*" & sembol1 & "*", Operator:=xlAnd
Range("A2:A" & Cells(Rows.Count, 1).End(3).Row).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Range("A1").Select
ActiveSheet.Name = sembol1

'kopyaladığımız kayıtları sayalım
say = Cells(1, "A").End(xlDown).Row
'işlerbitti tekrar sayfa 1 seçip normale çeviriyoruz
Sheets("Sayfa1").Select
Selection.ClearContents
Application.CutCopyMode = False
Selection.AutoFilter
Range("A1").Select

'bir önceki sorgudan eksilen satırları yanaştırıp veri sayfasını düzenlemek için
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Select
ActiveSheet.Columns("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
Range("A1").Select
ActiveCell.FormulaR1C1 = "."
TextBox1.SetFocus


'saydığımız veriyi mesaj kutusuyla bildirelim
acıklama = kapsama & " satırlık veriden " & sembol1 & " içeren toplam " & say & " kayıt tespit edilip kopyalandı"
buton = vbOKOnly + vbInformation + vbDefaultButton1
baslık = "BU İYİLİĞİMİ DE UNUTMAYIN!"
MsgBox acıklama, buton, baslık
TextBox1.Text = ""
TextBox1.SetFocus



End If
 
İSim bulduğunda makronun sonlanması için şu şekilde kullanabilirsiniz:

if Sheets(a).Name = sembol1 Then goto 10

...
..
...

10:
End sub

Bu şekilde yaptığınızda a = sembol1 olduğunda 10 olarak belirlediğimiz satıra gider ve o satırda da makro sonlandırıldığı için tüm işlemi bırakır.
 
Ok bu iyi bir fikir.
Beki arama kriteri yoksa...
Bunu belki süzme işleminde seçim yapıyoruzya, süzme adımından hemen sonra, süzmede çıkan satırları say desek ve sayım sonucu sıfırsa bulunamadı diye bir mesaj verip sonlandırsa çözülür ama süzmede çıkan sonucu nasıl saydıracağımı bilmiyorum. Ben bu makroda satırı

Range("A2:A" & Cells(Rows.Count, 1).End(3).Row).Select

koduyla saydığım için sonuç yoksa a2 den sonra control+alt ok yapınca excelin sonuna gidiyor 1048536. satıra ve o kadar sonuç bulunup kopyalandı diyor. Bu bir hata süzme sonucunda "dolu satırları say " demenin bir yolu yok mu?
 
If countif([A1:A5000], kriter) =0 then goto 10

Şeklinde sorgu kriterinize Eğersay uygulayabilirsiniz.
 
YUSUF44 çok teşekkür ederim.
bu countif yerine counta ile yapmak daha uygun olur diye düşünüyorum ama ofis türkçe olduğundan mıdır bilmiyorum. Hata veriyor. Türkçesini yani BAĞ_DEĞ_DOLU_SAY kullanınca vb kabul etmiyor. ben sözdiziminde mi hata ediyorum acaba...?

" Compile Error
Sub or Function not defined " diye hata veriyor hem COUNTA için hem de COUNTİF için nerde hata yapıyorum acaba
 
Son düzenleme:
WorksheetFunction.CountIf

Olması lazım. County için de

WorksheetFunction.Counta

Deneyin. Önceki mesajımda unutmuşum, kusura bakmayın.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst