• DİKKAT

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

Her Virgül sonrası değer alt satıra almak

M

MURATSO

Katılım
3 Nisan 2014
Mesajlar
173
Excel Vers. ve Dili
excel 2010
arkadaşlar merhaba,
ekli excelde çektiğim rapor aynen bu şekilde geliyor, istediğim şey ise D kolonunda Screen değerine karşılık gelen E kolonundaki değerlerin alt alta sıralanması. yani her bir satırda sadece tek değer olsun bu yapılabilir mi?

teşekkür ederim şimdiden.
 

Ekli dosyalar

Merhaba.

Örneğin ilk hücreden hareketle 31 satır olacak.
Peki A, B, C, D ve F sütunundaki veriler eklenen bu satırların hizasına tekrar tekrar aynen mi yazılacak yoksa,
verilerin mevcut konumu yerine 31 satırlık yeni bir veri sütunu mu oluşacak acaba?
.
 
merhaba,

dediğiniz gibi A, B, C, D ve F sütunundaki veriler eklenen bu satırların hizasına tekrar aynen yazılacak. Bu arada bu satır sayısı örnekte az o yüzden excel satır sayısının sonuna karada baz alabilir misiniz?
 
Tekrar merhaba.

-- Alt taraftan sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- Açılan VBA ekranının sağındaki boş alana aşağıdaki kod'u yapıştırın,
-- Sayfaya ekleyeceğiniz bir düğme/metin kutusu/şekil ile kod'u ilişkilendirip bu düğmeye/metin kutusuna/şekle tıklayarak kod'u çalıştırın.
-- veya VBA ekranında iken F5 tuşuna basarak kod'u çalıştırın.
.
Kod: 
[FONT="Arial Narrow"]Sub ayrıştır_listele_brn()
[A2].Select: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Range("E:E").Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
Range("E:E").NumberFormat = "@"
    For satır = [A65536].End(3).Row To 2 Step -1
        If Cells(satır, "E") = "" [B][COLOR="Blue"]Or Cells(satır, "D") <> "Screens"[/COLOR][/B] Then GoTo 10
        If Len(Cells(satır, "E")) = Len(WorksheetFunction.Substitute(Cells(satır, "E"), ",", "")) Then GoTo 10
            ilave = Len(Cells(satır, "E")) - Len(WorksheetFunction.Substitute(Cells(satır, "E"), ",", ""))
            Rows(satır + 1 & ":" & satır + ilave).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range("A" & satır & ":D" & satır).Copy Range("A" & satır & ":D" & satır + ilave)
            Range("F" & satır & ":F" & satır).Copy Range("F" & satır & ":F" & satır + ilave)
                Cells(satır, "E").Copy [AB2]
                [AB2].TextToColumns Destination:=Range("AC2"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, Comma:=True
                Range(Cells(2, "AC"), Cells(2, [AB2].End(2).Column)).Copy
                Cells(satır, "E").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, Transpose:=True
                Range(Cells(2, "AB"), Cells(2, [AB2].End(2).Column)).ClearContents
10: Next
Columns("E:E").AutoFit: [A1].Activate
Application.ScreenUpdating = [B][COLOR="blue"]True[/COLOR][/B]: Application.Calculation = xlCalculation[B][COLOR="Blue"]Automatic[/COLOR][/B]
MsgBox "İŞLEM TAMAM..."
End Sub[/FONT]
 
Son düzenleme:
Ömer bey elinize sağlık süper olmuş :) bu çalıştırmayı D kolonunda sadece Screens yazanlar için yapmamız mümkün müdür?
 
Önceki cevabımdaki kod'a ilave yaptım.
Kod'daki mavi renklendirdiğim kısımı eklemeniz yeterli olacaktır.
Ayrıca kod'un sondan üçüncü satırındaki True ve Automatic kısmını da değiştirin, atlamışım.

NOT: Önceki cevabımda yazmayı unutmuşum.
Kod AA ve devamı sütunları kullanıyor, AA sütunundan itibaren sağ tarafa veri yazmayınız, silinir.
.
 
Son düzenleme:
bir sorum daha olacak H4:BW452000 arasınde serpiştirilmiş şekilde 1, -1, 0, 9, ve 2 değerleri var bu değerleri macro ile değiştirebilir miyim?

istediğim ise: 1 ve 9 yazan değerleri silsin hücre boş kalsın, 2 yazan değer yerine Mükerrer, -1 yazan değer yerine Hatalı, 0 yazan değer yerine Boş yazılması sağlanabilir mi?

teşekkür ederim
 
Merhaba.
Söylediğiniz husus kolay ancak birşey sorayım.
Virgül dolayısıyla eklenen satırların durumu ne olacak?
Bu satırlarda da bahsettiğiniz değerler varsa bu sütunlar da önceki sütunlar gibi, eklenen satırlara kopyalanacak mı?
Şu an bilgisayar başında değilim, cep telefonundan yazıyorum.
Cevabınıza göre kod'daki değişikliği bir-birbuçuk saat sonra yapabilirim.
 
aslında virgül yok sadece belirttiğim değerler var. Bahsettiğim alan içerisinde eğer 1 ve 9 görürse 1 ve 9 değerini silsin yani hücre boş olsun, 2 değeri görürse text olarak "Mükerrer" yazsın, 0 değeri görürse text olarak "Boş" yazsın, -1 değerini görürse text olarak "Hatalı" yazsın. bunu yeni bir macro olarak ele alırsanız çok sevnirim. örnek dosya ekledim
 

Ekli dosyalar

Merhaba.

Bugün biraz özel işlerim vardı. Ancak fırsat buldum.
Alt taraftan, işlem yapılacak sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin.
Açılan VBA ekranında, sağ taraftaki boş alana aşağıdaki kod'u yapıştırın.
VBA ekranında iken F5 tuşuna basarak kod'u çalıştırın.

Kod'daki işlem yapılacak alan sayfanın tümü için, kullanılan hücre aralığı olarak tanımlandı.
İsterseniz mavi kısmı, Range("G3:BG1000") gibi belli bir alanda işlem yapacak şekilde değiştirebilirsiniz.
.
Kod: 
[FONT="Arial Narrow"]Sub değiştir()
Dim hücre As Range
For Each hücre In Range([COLOR="Blue"]"A1:" & [A1].SpecialCells(xlLastCell).Address(0, 0)[/COLOR])
If hücre = "" Then GoTo 10
    Select Case hücre.Value
        Case Is = -1: hücre = "HATALI"
        Case Is = 0: hücre = "BOŞ"
        Case Is = 1: hücre = ""
        Case Is = 2: hücre = "MÜKERRER"
        Case Is = 9: hücre = ""
    End Select
10: Next hücre: MsgBox "İŞLEM TAMAMLANDI..."
End Sub[/FONT]
 
istediğim aralık "H4:BW331538" olduğunu düşünürsek aşağıdaki gibi mi değiştirmeliyim?
For Each hücre In Range("H4:BW331538")
 
Çok teşekkür ederim Ömer bey; ellerinize sağlık :)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst