excel'de bir hücredeki veriyi diğer hücreye alt altalta otomatik aktarma

[esilakarlı]

excel de A ve B hücresinde veri var A hücresinde model ve B hücresinde tire(- işareti) ile ayrılmış araba serileri var.

şimdi yapamadığım: B hücresindeki tire ile ayrılmış değerleri alt alta satırlara yazdırmak akabinde A hücresindeki veriyi de eşleşecek şekilde alt alta sıralamak
örneğin şunun gibi

145​	1.4
145​	1.6
145​	1.7
145​	2.0

33	1.7
145	1.4 - 1.6 - 1.7 - 2.0
146	1.4 - 1.6 - 2.0 Ti
147	1.6 TS - 1.9 - 2.0 TS
156	1.6 TS - 1.9 JTD - 2.0 JTS - 2.0 TS - 2.5
159	1.9 JTD - 1.9 JTS - 2.4 JTD
164	2.0
166	2.0 - 2.4 - 2.5
Brera	2.2
Giulia	2.0
Giulietta	1.4 TB - 1.6 JTD - 1.75 TBI
GT	1.9 JTD - 2.0 JTS
GTV	2.0
MiTo	1.3 JTD - 1.4 T - 1.6 JTD
Spider	2.0 TS
A110	S
A	A2 - A2 SL
SV	1.6
DB7	Coupe
DB9	Coupe - GT 007 Bond Edition
DB11	Coupe
DBS	DBS Coupe - DBS Volante
Rapide	5.9 - 6.0
Vanquish	V12
Vantage	V8 Vantage - V8 Vantage S
Virage	Volante
A1	1.4 TFSI - 1.6 TDI
A2	1.4 TDI
A3 Cabrio	1.2 TFSI - 1.4 TFSI - 1.5 TFSI - 1.6 - 1.8 TFSI
A3 Hatchback	1.4 TFSI - 1.6 - 1.6 TFSI - 1.6 TDI - 1.8 - 1.8 T - 1.9 TDI - 2.0 FSI - 2.0 TDI
A3 Sedan	1.0 TFSI - 1.2 TFSI - 1.4 TFSI - 1.5 TFSI - 1.6 TDI - 35 TFSI
A3 Sportback	1.0 TFSI - 1.2 TFSI - 1.4 TFSI - 1.5 TFSI - 1.6 - 1.6 FSI - 1.6 TDI - 1.8 - 1.8 TFSI - 1.9 TDI - 2.0 FSI - 2.0 TDI - 3.2
A4 Avant	1.4 TFSI - 1.6 - 1.8 - 1.8 T - 1.8 TFSI - 1.9 TDI - 2.0 TDI - 2.0 TDI Quattro - 2.0 TDI Sport - 2.0 TFSI Quattro - 2.5 TDI - 2.5 TDI Quattro - 3.0 - 2.0

 

[esilakarlı]

Lütfen yardımcı olun

 

[Ömer]

Merhaba,

Deneyiniz.
Sayfa1 deki verileri Sayfa2 ye listeler.

Sub test()
    
    Dim S1 As Worksheet, S2 As Worksheet, i As Long, sat As Long, j As Integer, d
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    S2.Select
    Range("A2:B" & Rows.Count) = ""
    Columns("B:B").NumberFormat = "@"
    
    sat = 2
    For i = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
        d = Split(S1.Cells(i, "B"), "-")
        For j = 0 To UBound(d)
            Cells(sat, "A") = S1.Cells(i, "A")
            Cells(sat, "B") = Trim(d(j))
            sat = sat + 1
        Next j
    Next i
    
    MsgBox "İşlem Bitti."
    Application.ScreenUpdating = True
    
End Sub

 

[esilakarlı]

Set S2 = Sheets("Sayfa2") hata veriyor

 

[Ömer]

Dosyanızda Sayfa2 adında bir çalışma var mı?
Buradaki Sayfa2 yi siz kendi dosyanızda verilerin listeneceği sayfa adı neyse onunla değiştiriniz. Aynı şekilde Sayfa1 içinde gerçerli olmak üzere kendi çalışmanızdaki sayfa adı ile değiştiriniz.

 

[esilakarlı]

Ömer bey deneyeceğim. eğer makro çalışır ise 3200 model satır var A sütununda işlem çok çok uzun sürermi

 

[Ömer]

3200 veride çok uzun sürmez. Bu çokluktaki veride 1-2 sn. civarı işlemi bitir. Eğer hızla ilgili sorun yaşarsanız bildiriniz.
Örnek çalışmayı ekteki linkten indirebilirsiniz.

İndir Kitap1 Kopya

Dosyayı indir Kitap1 Kopya

dosya.co

.

 

[esilakarlı]

Ömer bey çok çok çok teşekkür ederim işe yaradı. Gerçekten sağ olun. Bu makroyu sık sık kullanacağım...