UserForm TextBox içerisine Excel Çalışma Sayfası hücrelerden verileri getirme

[u.L.a.s]

Merhabalar

Bir userform üzerinde uzunlamasına yarattığım bir textbox ım var

Bu textbox içerisine Sheet1 de A1 hücresi ile A129 hücresi arasındaki tüm verileri
aynı çalışma sayfasında olduğu gibi alt alta getirmek istiyorum.

Kod düzeneğim aşağıdaki gibi fakat textbox bu kod düzeninde bomboş oluyor

Private Sub UserForm_Initialize()
TextBox_sonuc.Value = Sheets("Sheet1").Range("A1:A129").Text
End Sub

Kod düzeneğini aşağıdaki gibi bırakırsam sadece A1 hücresindeki veri geliyor. haliyle diğer veriler gelmiyor.

Private Sub UserForm_Initialize()
TextBox_sonuc.Value = Sheets("Sheet1").Range("A1").Text
End Sub

Bilgi ve yardımlarınızı rica ederim

 

[Emir Hüseyin Çoban]

. . .

Bu işlemi hangi amaçla çalışmanızda kullanıyorsunuz.
Listbox ile yapmak daha uygun olur gibi.

. . .

 

[u.L.a.s]

maksadım bu hücre aralığındaki düzeneği userform üzerinde görüntüleyip kopyala yapıştırla başka yere atmak istiyorum. list boxta kopyala yapıştır yapamıyorum sanırım

 

[ÖmerBey]

Aşağıdaki kodları deneyiniz.

Private Sub UserForm_Initialize()
Dim liste()
Set alan = Sheets("Sheet1").Range("A1:A129")

For Each a In alan
    ReDim Preserve liste(x)
    liste(x) = a.Text
    x = x + 1
Next

TextBox_sonuc.Value = Join(liste, Chr(10))
End Sub

 

[Emir Hüseyin Çoban]

. . .

Private Sub UserForm_Initialize()
    metin = Empty
    TextBox_sonuc.MultiLine = True

    For i = 1 To 129
        metin = metin & Sheets("Sayfa1").Cells(i, "A") & Chr(10)
    Next i

    TextBox_sonuc = metin
End Sub

. . .

 

[u.L.a.s]

çok teşekkür ederim üstadım. peki bu textboxın yanında bir buton koydum.

Bu butonla tümünü seç yapmak nasıl olur
2. butonada kopyalama komutunu koymak istiyorum.

yani textbox verisi içerisindeki veriyi 1. butonla tümünü seçip 2. butonla kopyala yapmak istiyorum

 

[Emir Hüseyin Çoban]

. . .

Private Sub CommandButton1_Click()
   Range("[COLOR="blue"]B1[/COLOR]").Value = TextBox_sonuc.Text
End Sub

. . .

 

[u.L.a.s]

Hüseyin bey merhaba
verdiğiniz kod Textbox içeriğini B1 e aktardı. Ben hücre içine bir veri atsın istemiyorum.

Textbox içeriğini tümünü seçsin bloklasın yani bunu ben fare ile yapmayayım.

sonra 2. butonlada kopyala komutunu gerçekleştirsin.

Bu site üstünde Code taglarına aldığımı bir veriyi foruma gönderdiğimizde tablonun üstünde Tüm kodu seç butonu var ya. onun gibi bir işlev istiyorum ben

 

[Emir Hüseyin Çoban]

. . .

Kodları Sy Tarkan Vural' ın html maker çalışmasından aldım.

Private Sub CommandButton1_Click()
[COLOR="Green"]' tümünü seç[/COLOR]
TextBox_sonuc.SelStart = 0
TextBox_sonuc.SelLength = Len(TextBox_sonuc.Text)
TextBox_sonuc.SetFocus
End Sub


Private Sub CommandButton2_Click()
[COLOR="Green"]' kopyala[/COLOR]
Dim Secim As New DataObject
Set Secim = New DataObject
    Secim.SetText TextBox_sonuc.Text
    Secim.PutInClipboard
End Sub

. . .

 

[u.L.a.s]

. . .

Kodları Sy Tarkan Vural' ın html maker çalışmasından aldım.

Private Sub CommandButton1_Click()
[COLOR="Green"]' tümünü seç[/COLOR]
TextBox_sonuc.SelStart = 0
TextBox_sonuc.SelLength = Len(TextBox_sonuc.Text)
TextBox_sonuc.SetFocus
End Sub


Private Sub CommandButton2_Click()
[COLOR="Green"]' kopyala[/COLOR]
Dim Secim As New DataObject
Set Secim = New DataObject
    Secim.SetText TextBox_sonuc.Text
    Secim.PutInClipboard
End Sub

. . .

Burdan tarkan hocamada teşekkürlerimi iletiyorum.
Ayrıca seninde bilgilerin için çok teşekkür ederim
mucit77 sanada çok teşekkürler

Kopyala kodu bile işlevi görüyor aslında.

Emeğinize bilginize sağlık

 

[u.L.a.s]

Merhaba

bu kod düzeneğinde bir şey sormak istiyorum

Range("A1:A129") aralığını Range("A23:A65") yaparsam textbox içerisine A23 yukarısındaki satırlar boş satır gibi geliyor ve TextBox görüntüsü aşağıdaki resimdeki gibi oluyor. Ben bunu şu yüzden istiyorum Bir tane TextBox içeriği yerine 3 ayrı TextBox içeriğine bu verileri getireyim istedim bunuda A1:A129 aralığındaki hücre verisini 3 e böldüm.

Private Sub UserForm_Initialize()
Dim liste()
Set alan = Sheets("Sheet1").Range("A1:A129")

For Each a In alan
    ReDim Preserve liste(x)
    liste(x) = a.Text
    x = x + 1
Next

TextBox_sonuc.Value = Join(liste, Chr(10))
End Sub

Ben bu 3 textbox ayırma işlemini şu kod düzeneğini uyguladım

Private Sub UserForm_Initialize()
Dim liste1()
Set alan1 = Sheets("Sheet1").Range("A1:A42")
For Each a In alan1
    ReDim Preserve liste1(x)
    liste1(x) = a.Text
    x = x + 1
Next
TextBox1.Value = Join(liste1, Chr(10))
Dim liste2()
Set alan2 = Sheets("Sheet1").Range("A43:A93")
For Each a In alan2
    ReDim Preserve liste2(x)
    liste2(x) = a.Text
    x = x + 1
Next
TextBox2.Value = Join(liste2, Chr(10))
Dim liste3()
Set alan3 = Sheets("Sheet1").Range("A94:A138")
For Each a In alan3
    ReDim Preserve liste3(x)
    liste3(x) = a.Text
    x = x + 1
Next
TextBox3.Value = Join(liste3, Chr(10))

End Sub

 

[ÖmerBey]

Bütün değerleri değiştirmişsiniz ama "x" değerine dokunmamışsınız.
İlk döngü içerisinde x 42'ye kadar çıkıyor sonra kaldığı yerden devam ediyor. yani siz liste2'ye 42'den itibaren değer veriyorsunuz.
Döngülerin arasında x= 0 yazarsanız problem düzelir.

Private Sub UserForm_Initialize()
Dim liste1()
Set alan1 = Sheets("Sheet1").Range("A1:A42")
For Each a In alan1
    ReDim Preserve liste1(x)
    liste1(x) = a.Text
    x = x + 1
Next
TextBox1.Value = Join(liste1, Chr(10))
[COLOR="red"]x = 0[/COLOR]
Dim liste2()
Set alan2 = Sheets("Sheet1").Range("A43:A93")
For Each a In alan2
    ReDim Preserve liste2(x)
    liste2(x) = a.Text
    x = x + 1
Next
TextBox2.Value = Join(liste2, Chr(10))
[COLOR="Red"]x = 0[/COLOR]
Dim liste3()
Set alan3 = Sheets("Sheet1").Range("A94:A138")
For Each a In alan3
    ReDim Preserve liste3(x)
    liste3(x) = a.Text
    x = x + 1
Next
TextBox3.Value = Join(liste3, Chr(10))

End Sub