veriyi düzenleme

[cengiz123]

merhabalar,
Bir veri tablom var.
bu veri tablom'da bir adım da kod düzenledim, ancak çok yavaş çalışıyor.

A,B,C sütüunlarında veriler var.
ancak A sütunundaki veriler tek sütun için virgüllerle ayrılmış ortak verilerle dolu. C sütunundaki veriler artınca excel de kasma yaşanıyor.
dosyayı aşağıdaki linke yükledim.

yapılmasını istediğim ise;
C sütünunda virgüllerle ayrılmış verileri ayıracak ve karşısında A ve B verileri ile birlikte J-K-L sütunlarına yazılacak.
J sütüununda A sütünundaki değer
K sütununda B sütunundaki değer
L de ise ayrılmış olan değer yer alacak.

karışık anlattım ama dosyada oldukça sade.
şimdiden teşekkürler

https://www.dosyaupload.com/hRSW

 

[alicimri]

Aşağıdaki kod İşinizi görür dilerim.

Sub ayir()
For i = 2 To Range("A65536").End(3).Row
bol = Split(Range("E" & i), ",")
For e = 0 To UBound(bol)
say = Range("I65536").End(3).Row + 1
Range("I" & say).Value = Range("A" & i)
Range("J" & say).Value = Range("B" & i)
Range("K" & say).Value = Range("C" & i)
Range("L" & say).Value = Range("D" & i)
Range("M" & say).Value = bol(e)
Next
Next
End Sub

 

[cengiz123]

alicimri hocam
elinize sağlık kod çok güzel çalışıyor.
tekrardan çok teşekkür ederim

 

[cengiz123]

Ali Cimri hocam,
A,B,C,D,E de verilerimiz olsaydı ve I,J,K,L,M'ye veriler çekilseydi nasıl bir kod düzenlemesi gerekli olurdu.

veriler C'de değil, E'de olacak ve K'ya değil Mye kaydedecek.
Birde A ile D arasındaki veriyi çekerken çok zaman alıyor. bunu Dizi şekline döndürebilir miyiz.


bol = Split(Range("E" & i), ",")
Range("M" & say).Value = bol(e)

çok teşekkürler

 

[cengiz123]

Bu işlemin daha hızlı olarak yapılabilme yolu var mıdır?

 

[cengiz123]

Bu konuda yardımcı olabilecek ustalardan destek bekliyorum

 

[alicimri]

Yukardaki #2 nolu mesajı yeniledim ama "diziye dönüştürüp hızlandırma" konusunu anlamadım.

 

[cengiz123]

Ali cimri hocam çok teşekkürler desteğiniz için.
Tek tek hücre hücre yazınca, veri çok olunca çok zaman alıyor. 4 hücreyi aynı andan yazdırma belki hızlandırabilir diye düşündüm. Copy paste yaptım. Oda yavaşlatıyor. Hızlı bir çözüm bulamadım maalesef

 

[cengiz123]

Merhabalar
Bu konuda yardımcı olabilecek ve kodun hızlı çalışmasını sağlayacak desteklerinizi rica ediyorum

 

[Ömer BARAN]

Merhaba, Sayın alicimri'nin müsadeleriyle.

Alternatif olarak aşağıdaki kod'u deneyiniz, hız sorununun olmaması gerekir.

Alt taraftan uygulama yapılacak sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılan VBA ekranında sağdaki boş alana aşağıdaki kod'u yapıştırın ve çalıştırın.
.

[B][COLOR="blue"]Sub BARAN_LISTELE()[/COLOR][/B]
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
sonsat = Cells(Rows.Count, 1).End(3).Row
Columns("M:M").Insert Shift:=xlToRight
With Range("M2:M" & sonsat)
    .Formula = "=LEN(C2)-LEN(SUBSTITUTE(C2,"","",""""))+1": .Value = .Value
End With
suts = WorksheetFunction.Max([M:M])
Range("C2:C" & sonsat).TextToColumns Destination:=Range("N2"), DataType:=xlDelimited, Comma:=True
If Cells(Rows.Count, "J").End(3).Row > 1 Then Range("J2:L" & Cells(Rows.Count, "J").End(3).Row).ClearContents
For sat = 2 To sonsat
    For ssut = 14 To 13 + suts
        If Cells(sat, ssut) = "" Then Exit For
        brn = Cells(Rows.Count, "J").End(3).Row + 1
        Cells(brn, "J") = Cells(sat, 1): Cells(brn, "K") = Cells(sat, 2): Cells(brn, "L") = Cells(sat, ssut)
    Next
Next
Range(Cells(1, 13), Cells(sonsat, 13 + suts)).Delete Shift:=xlToLeft
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı.", vbInformation, "..:: Ömer BARAN ::.."
[B][COLOR="Blue"]End Sub[/COLOR][/B]

 

[cengiz123]

ömer bey merhaba
çok teşekkürler. denedim gayet başarılı.
çok teşekkürler tekrardan

 

[Ömer BARAN]

Kolay gelsin.