Çözüldü textbox ve labeldeki veriyi her hücreye bir karakter gelecek şekilde ayırma

[zulfuernek]

araştırdım ama bulamadım.

textbox1 deki veriyi I15 satırından başlayarak her hücreye bir karakter gelecek şekilde nasıl kodlama yaparız. I15 J15 K15 L15 M15 diye devam ediyor. tekxtbox karakter sayısı en fazla 10 karakterdir.

birde label2 de 01.02.2019 diye tarih yazıyor burdaki karakteride 01 (gün sayısını I18 ve J18 e. - 02 (ay) sayısını L18 ve M18 e yıl karakterini ise O18 18 Q18 R18 e gelecek şekilde nasıl ayarlarız. bunları butona tıklayınca yapmalı

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodları deneyin.

Private Sub CommandButton1_Click()
    Dim Bak As Integer
    Dim K_Say As Integer
    K_Say = Len(TextBox1.Text)
    For Bak = 0 To K_Say - 1
        Cells(15, "I")(1, Bak) = Left(Right(TextBox1.Text, K_Say - Bak), 1)
    Next
    Range("I18,J18").Value = Day(Label1.Caption)
    Range("L18,M18").Value = Month(Label1.Caption)
    Range("O18,Q18,R18").Value = Year(Label1.Caption)
    Range("I18,J18").NumberFormat = "00"
    Range("L18,M18").NumberFormat = "00"
End Sub

 

[zulfuernek]

@dalgalikur hocam 2 eksiğim var.

birincisi textbox1 den alacağı değeri dediğimiz gibi tek tek ayırıp ilgili hücrelere atıyor ancak j sütunundan başlıyor.

ikincisi ise gün ay ve yılıda hücrelere atıyor ancak çşyleki; mesela gün 2 ise 2 yi bir hücreye 0 ı bir hücreye yazacağı yerde her iki hücreyede 20 yazıyor. ay ve yıllarda aynı şekilde

 

[Muzaffer Ali]

O zaman aşağıdaki kodları kullanın.

Private Sub CommandButton1_Click()
    Dim Bak As Integer
    Dim K_Say As Integer
    Dim Gun As String
    Dim Ay As String
    K_Say = Len(TextBox1.Text)
    For Bak = 0 To K_Say - 1
        Cells(15, "I")(1, Bak + 1) = Left(Right(TextBox1.Text, K_Say - Bak), 1)
    Next
    If Day(Label1.Caption) < 10 Then
        Gun = 0 & Day(Label1.Caption)
    Else
        Gun = Day(Label1.Caption)
    End If
    If Month(Label1.Caption) < 10 Then
        Ay = 0 & Month(Label1.Caption)
    Else
        Ay = Month(Label1.Caption)
    End If
    Range("I18").Value = Left(Gun, 1)
    Range("J18").Value = Right(Gun, 1)
    Range("L18").Value = Left(Ay, 1)
    Range("M18").Value = Right(Ay, 1)
    Range("O18").Value = 2
    Range("P18").Value = 0
    Range("Q18").Value = Left(Right(Year(Label1.Caption), 2), 1)
    Range("R18").Value = Right(Year(Label1.Caption), 1)
End Sub

 

[zulfuernek]

@dalgalikur hocam oldu. hemde mükemmel. ellerine emeklerine sağlık. çok teşekkür ederim

 

[Korhan Ayhan]

Alternatif,

Private Sub CommandButton1_Click()
    Range("I15:R15").ClearContents
    ReDim Dizi(1 To Len(TextBox1))
    
    For X = 1 To Len(TextBox1)
        Dizi(X) = Mid(TextBox1.Value, X, 1)
    Next

    Range("I15").Resize(1, UBound(Dizi)) = Dizi
    
    Range("I18") = Mid(Label2.Caption, 1, 1)
    Range("J18") = Mid(Label2.Caption, 2, 1)
    Range("L18") = Mid(Label2.Caption, 4, 1)
    Range("M18") = Mid(Label2.Caption, 5, 1)
    Range("O18") = Mid(Label2.Caption, 7, 1)
    Range("P18") = Mid(Label2.Caption, 8, 1)
    Range("Q18") = Mid(Label2.Caption, 9, 1)
    Range("R18") = Mid(Label2.Caption, 10, 1)
End Sub

 

[zulfuernek]

bunuda deniyorum korhan hocam. çok teşekkür ederim ilginiz için.

 

[veyselemre]

Private Sub CommandButton1_Click()
    astr = Format(CDate(Label1.Caption), "dd mm yyyy")
    For i = 1 To Len(astr)
        Cells(18, i + 8) = Mid(astr, i, 1)
    Next i
    astr = TextBox1.Text
    For i = 1 To Len(astr)
        Cells(15, i + 8) = Mid(astr, i, 1)
    Next i
End Sub