Ayraçlar arasından veri çekmek

[cebelitarık]

Sevgili arkadaşlar
Aşağı eklediğim örnekte, sayfanın A2 hücresinden itibaren A sütununda % işareti ile ayrılmış çeşitli değerler mevcut. B2 hücresine yazdığım rakam değerini referans alarak, (örneğin 2. değerler) ayraçlar (%) arasından veri çekmek istiyorum ve bu değerlerin C2 hücresinden itibaren aşağı doğru sıralanmasını istiyorum.
Bu işlemin VBA ile yapılması gerekiyor. Formülle yapılabilirse formülün yazılışınıda görmek isterim.
Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

 

[hamitcan]

Sub ayir()
c = 1
For j = 2 To [a65536].End(3).Row
 a = Split(Cells(j, "a"), "%")
 s = 0
 c = c + 1
For i = 0 To UBound(a)
        If a(i) <> "" Then
            s = s + 1
            If s = 2 Then Cells(c, "c") = a(i)
        End If
Next i
Next j
End Sub

 

[cebelitarık]

Sayın Hamitcan ilgin için teşekkür ederim.
Kodlar güzel çalışıyor ancak tam istediğim şu şekilde:
B2 hücresi referans alınsın istiyorum
örneğin B2 hücresinde 1 yazıyorsa ayraçlar arasından ilk birinci değerler ayıklansın. Yok B2 hücresinin değeri 4 ise ayraçlar arasında gizlenmiş 4. veriler çekilsin istiyorum. Yani B2 hücresinin değerini isteğe göre değiştirebileyim istiyorum.
Yardımlarınız için teşekkür ederim.

 

[hamitcan]

If s = [color=red]2[/color] Then Cells(c, "c") = a(i)

satırını

If s = [B2] Then Cells(c, "c") = a(i)

aşağıdaki satır ile değiştirin.

 

[cebelitarık]

Sayın Hamitcan
Çok teşekkür ederim. bizde yavaş yavaş sayenizde öğrenmye çalışıyoruz
dosyanın son şeklini aşağıya ekliyorum. ancak istediğim gibi olması için çok az bir pürüz oda şu:
A3 ve A6 satırında % işaretlerinin en başında hiç sayı değeri olammasına rağmen boş getirecek yere ilk bulduğu değeri getiriyor.
Yani A3 ve A6 satırları için birinci değer olarak boş gelmesi lazım çünkü en başta değer yok

Tekrar teşekkürler

 

[hamitcan]

Aşağıdaki şekilde deneyin.

Sub ayir()
son = [a65536].End(3).Row
If [b2] = 1 Then Range("c2:c" & son).ClearContents: Exit Sub
c = 1
For j = 2 To son
 a = Split(Cells(j, "a"), "%")
 s = 0
 c = c + 1
For i = 0 To UBound(a)
        If a(i) <> "" Then
            s = s + 1
            If s = [b2] Then Cells(c, "c") = a(i)
        End If
Next i
Next j
End Sub

 

[cebelitarık]

Sayın Hamitcan
Galiba eksik anlattım.
B2 hücre değeri 1 olduğunda,
A3 ve A6 satırında, % işaretlerinin en başında hiç sayı değeri olmadığından sadece A3 ve A6 değerleri karşılığı boş gelecek, fakat A2,A4,A7,A8,A9,A10 hücrelerinde ilk olarak sayı değeri bulunmakta bu yüzden bu satırlara karşılık gelen C2,C4,C7,C8,C9,C10 hücreleride karşılık gelen değerler dolu gelmesi lazım
Yani A3 ve A6 satırları için birinci değer olarak boş gelmesi lazım çünkü en başta değer yok
Diğerlerinde ilk başta değer var onlar gelmesi lazım.
Son bir el atarsan inşaallah düzelecek
B2 değeri 1 olduğunda gelmesi gereken değerleri örnek olarak yeni ekli dosyada belirttim. Örneğide biraz görselleştirdim. Sadece B2 nin 1 değeri için verdiğim örnek üzerine çalışmak lazım diğer değerler için doğru sonuçları alıyorum.
Teşekürler

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub KARAKTER_AYIR()
    Dim X As Long, Y As Integer, AYIR() As String, SAY As Integer
    Range("C2:C" & [A65536].End(3).Row).ClearContents
    For X = 2 To [A65536].End(3).Row
        If [B2] = 1 Then
        If Mid(Cells(X, 1), 1, 1) <> "%" Then
            AYIR = Split(Cells(X, 1), "%")
            SAY = 0
            For Y = 0 To UBound(AYIR())
            If AYIR(Y) <> "" Then
            SAY = SAY + 1
            If SAY = [B2] Then Cells(X, 3) = AYIR(Y) * 1
            GoTo Devam
            End If
            Next
        End If
        
        Else
            
            AYIR = Split(Cells(X, 1), "%")
            SAY = 0
            For Y = 0 To UBound(AYIR())
            If AYIR(Y) <> "" Then
            SAY = SAY + 1
            If SAY = [B2] Then
            Cells(X, 3) = AYIR(Y) * 1
            GoTo Devam
            End If
            End If
            Next
        End If
Devam:
    Next
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[cebelitarık]

Sayın Korhan Ayhan
Tam istediğim gibi oldu teşekkür ederim.

 

[hamitcan]

Öncelikle, Korhan bey'in eline sağlık; verdiği çözüm için. Bununla birlikte, çözümün tamamlanmış halini de vermek isterim.

Sub ayir()
Range("C2:C10").ClearContents
son = [a65536].End(3).Row
c = 1
For j = 2 To son
 a = Split(Cells(j, "a"), "%")
 s = 0
 c = c + 1
If Not IsNumeric(Left(Cells(j, "a"), 1)) Then GoTo 10
For i = 0 To UBound(a)
        If a(i) <> "" Then
            s = s + 1
            If s = [b2] Then Cells(c, "c") = a(i)
        End If
Next i
10:
Next j
End Sub