• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hücre icini ayirma

  • Konbuyu başlatan Konbuyu başlatan mor45
  • Başlangıç tarihi Başlangıç tarihi
M

mor45

Katılım
30 Eylül 2005
Mesajlar
303
Excel Vers. ve Dili
2003 excel türkçe
Bir hücrede birden çok karakter var onları nasıl ayırabilirim.
Örnegin
1-1 1320 1-4 1500 A1 hücresinde bunlar var bunlar değer hücrelere ayırarak atmak istiyorum.A2 hücresine 1 A3 hcresine 1 A4 hücresine 1320 A5 hücresine 1 A6 hücresine 4 A7 hücresine 1500 olmalı.
Örnekteki diğer bir hücre 12-1 1600 12-1 1600 olabilir ilki bazen 1 bazen 2 karakter olabilir.
 
örnek dosyanızı eklerseniz yardımcı olabiliriz
 
dosyanız ektedir şekle tıklamanız yeterli olacaktır
 

Ekli dosyalar

Son düzenleme:
sayın catalinastrop yapmış olduğunuz dosyayı kendi dosyama uyguladım yalnız A1 ile B1 hücrelerini ayrı yazması gerekirken birleştiriyor mesala a1=1 B2=3000 iken C1=13000 yazıyor
Alttaki diğer hüçrelerde de böyle yapıyor. Yardımlarınızı bekliyorum.
 
dosya ekte
 
Son düzenleme:
sanırım şimdi olmuştur
 
dosya eklemeyi atlamışım :)
 
Ekteki dosyamda Der.Kod.Gös. olan sayfamda ikonu tıkladığımda makro çalışıyor .
Yalnız 4093 ten sonra satır devam ettiğimde ayrım yapamıyor,
Makroda modüle 3 te
(Selection.AutoFill Destination:=Range("C1:C40000"), Type:=xlFillDefault
Range("C1:C40000").Select ) olan modüle 3 te yazan yere
daha önce C1:C4000 iken çalışıyor,
ama C1:40000 yaparsak çoğaltmak için çalışmıyor,
o zaman 4093 satırından sonra ayrımda hata veriyor. (örgüç ile 1890) ayrı yazması gerekirken
(örgüç1890)olarak yazıyor,(D4093 hücresine)
Lütfen makronun 50000 satırına kadar çalışması için yardımcı olurmusunuz.
Yardımlarınızı bekiyorum.
Daha önce yardımcı olan arkadaşa (catalinastrap) teşekkür ediyorum.
 
Son düzenleme:
Makromun düzeltilmesi için yardım bekliyorum
 
Sn. mor45 vermiş olduğunuz örnek dosyalarda gerçek kimlik bilgilerinin olmamasına özen gösterirseniz daha iyi olur kanısındayım.
 
Sn.Tahsinanarat haklısınız.
Dosyaya yardımlarınızı bekliyorum.
 
Hücreleri Ayır

NOT; Ekteki dosyamda A ve B sütünlarında veriler var .Her hücrenin içindeki veriyi ayırarak örnekteki gibi sarı alanlara yazması. 4 satır dan 8 satra kadar olan 5 satır 1 kişinin verisi koyu çizgiler ile her kezin verisi belli bunları sarı alana ayırarak yazdırmak istiyorum.Makro ile yazdırmak için yardım ederseniz sevinirim. A ile B sütünundaki satırlar 9,500.000 fazla olabilecek veya sonsuz sayıda yazıldıkca. Daha önceden yazılmış bir makro vardı eksiği var 4000 sonra yanlış yazıyordu, eski makroda ekte. Yardımcı olursanız çok sevinirim

eski makro

Option Explicit
Sub Makro2()
'
' Makro2 Makro
'

'
Columns("C:I").Select
Range("j1").Activate
Selection.ClearContents
Range("C1").Select
ActiveCell.FormulaR1C1 = "=RC[-2]&RC[18]&RC[-1]"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C397"), Type:=xlFillDefault
Range("C1:C397").Select
ActiveWindow.ScrollRow = 358
ActiveWindow.ScrollRow = 357
ActiveWindow.ScrollRow = 353
ActiveWindow.ScrollRow = 347
ActiveWindow.ScrollRow = 340
ActiveWindow.ScrollRow = 338
ActiveWindow.ScrollRow = 335
ActiveWindow.ScrollRow = 334
ActiveWindow.ScrollRow = 326
ActiveWindow.ScrollRow = 320
ActiveWindow.ScrollRow = 313
ActiveWindow.ScrollRow = 312
ActiveWindow.ScrollRow = 308
ActiveWindow.ScrollRow = 305
ActiveWindow.ScrollRow = 299
ActiveWindow.ScrollRow = 295
ActiveWindow.ScrollRow = 291
ActiveWindow.ScrollRow = 285
ActiveWindow.ScrollRow = 281
ActiveWindow.ScrollRow = 273
ActiveWindow.ScrollRow = 223
ActiveWindow.ScrollRow = 212
ActiveWindow.ScrollRow = 207
ActiveWindow.ScrollRow = 163
ActiveWindow.ScrollRow = 147
ActiveWindow.ScrollRow = 143
ActiveWindow.ScrollRow = 118
ActiveWindow.ScrollRow = 108
ActiveWindow.ScrollRow = 104
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 1
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
"-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Columns("C:C").Select
Selection.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E14").Select
Application.CutCopyMode = False
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
"-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
Range("F26").Select
End Sub
 

Ekli dosyalar

Kodlarınızı code # tagları arasına alın lütfen. Çok kötü görünüyor.

Metni Sütunlara Dönüştürü deneyin..
 
Murat OSMA' Alıntı:
Kodlarınızı code # tagları arasına alın lütfen. Çok kötü görünüyor.

Metni Sütunlara Dönüştürü deneyin..
Genişletmek için tıkla ...

#Columns("C:I").Select
Range("j1").Activate
Selection.ClearContents
Range("C1").Select
ActiveCell.FormulaR1C1 = "=RC[-2]&RC[18]&RC[-1]"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C397"), Type:=xlFillDefault
Range("C1:C397").Select
ActiveWindow.ScrollRow = 358
ActiveWindow.ScrollRow = 357
ActiveWindow.ScrollRow = 353
ActiveWindow.ScrollRow = 347
ActiveWindow.ScrollRow = 340
ActiveWindow.ScrollRow = 338
ActiveWindow.ScrollRow = 335
ActiveWindow.ScrollRow = 334
ActiveWindow.ScrollRow = 326
ActiveWindow.ScrollRow = 320
ActiveWindow.ScrollRow = 313
ActiveWindow.ScrollRow = 312
ActiveWindow.ScrollRow = 308
ActiveWindow.ScrollRow = 305
ActiveWindow.ScrollRow = 299
ActiveWindow.ScrollRow = 295
ActiveWindow.ScrollRow = 291
ActiveWindow.ScrollRow = 285
ActiveWindow.ScrollRow = 281
ActiveWindow.ScrollRow = 273
ActiveWindow.ScrollRow = 223
ActiveWindow.ScrollRow = 212
ActiveWindow.ScrollRow = 207
ActiveWindow.ScrollRow = 163
ActiveWindow.ScrollRow = 147
ActiveWindow.ScrollRow = 143
ActiveWindow.ScrollRow = 118
ActiveWindow.ScrollRow = 108
ActiveWindow.ScrollRow = 104
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 1
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
"-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Columns("C:C").Select
Selection.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E14").Select
Application.CutCopyMode = False
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
"-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
Range("F26").Select#
End Sub
 
hfghfh

Resimdeki gibi yapacaksınız İhsan Bey...

Kodlarınızı seçip # simgesini seçeceksiniz.
 

Ekli dosyalar

  • hfghfh.jpg
    hfghfh.jpg
    70.3 KB · Görüntüleme: 9
code# Columns("C:I").Select
Range("j1").Activate
Selection.ClearContents
Range("C1").Select
ActiveCell.FormulaR1C1 = "=RC[-2]&RC[18]&RC[-1]"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C397"), Type:=xlFillDefault
Range("C1:C397").Select
ActiveWindow.ScrollRow = 358
ActiveWindow.ScrollRow = 357
ActiveWindow.ScrollRow = 353
ActiveWindow.ScrollRow = 347
ActiveWindow.ScrollRow = 340
ActiveWindow.ScrollRow = 338
ActiveWindow.ScrollRow = 335
ActiveWindow.ScrollRow = 334
ActiveWindow.ScrollRow = 326
ActiveWindow.ScrollRow = 320
ActiveWindow.ScrollRow = 313
ActiveWindow.ScrollRow = 312
ActiveWindow.ScrollRow = 308
ActiveWindow.ScrollRow = 305
ActiveWindow.ScrollRow = 299
ActiveWindow.ScrollRow = 295
ActiveWindow.ScrollRow = 291
ActiveWindow.ScrollRow = 285
ActiveWindow.ScrollRow = 281
ActiveWindow.ScrollRow = 273
ActiveWindow.ScrollRow = 223
ActiveWindow.ScrollRow = 212
ActiveWindow.ScrollRow = 207
ActiveWindow.ScrollRow = 163
ActiveWindow.ScrollRow = 147
ActiveWindow.ScrollRow = 143
ActiveWindow.ScrollRow = 118
ActiveWindow.ScrollRow = 108
ActiveWindow.ScrollRow = 104
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 1
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
"-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Columns("C:C").Select
Selection.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E14").Select
Application.CutCopyMode = False
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
"-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
Range("F26").Select
End Sub

Bu kadar yapabiliyorum. Ben kod yazmayı bilemiyorum
 
Aşağıdaki kodu deneyiniz.

Kod: 
Sub VERILERI_AYIR()
    Dim Veri As Range, X As Integer, Data() As String, Sutun As Byte
    
    Range("C:Z").Clear
    
    For Each Veri In Range("A1:B" & Cells(Rows.Count, 1).End(3).Row)
        If Veri.Column = 1 Then Sutun = 3
        Data = Split(Replace(Veri.Text, "-", " "), " ")
        For X = 0 To UBound(Data)
            If Data(X) <> "" Then
                Cells(Veri.Row, Sutun) = Data(X)
                Sutun = Sutun + 1
            End If
        Next
    Next
        
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst