• DİKKAT

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

Farklı sütünlardaki değerleri tek kalem olarak başka bir sütuna yazmak

  • Konbuyu başlatan Konbuyu başlatan wiibii
  • Başlangıç tarihi Başlangıç tarihi
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
W

wiibii

Katılım
25 Nisan 2012
Mesajlar
16
Excel Vers. ve Dili
2010
A SÜTUNU
MERCİMEK
SALÇA
UN
BAHARAT
TUZ
YAĞ

B SÜTUNU
TUZ
BULYON
MARGARİN
PİRİNÇ
ŞEHRİYE

C SÜTUNU
TAVUK
YAĞ
PATATES
TUZ

D SÜTUNU
KURU FASULYE
SALÇA
SOĞAN
TUZ
YAĞ






bu stokları e sütununda tek kalem olarak yazmak istiyorum
yani

E SÜTUNU
mercimek
yağ
salça
un
baharat
tuz
prinç
şehriye
margarin
bulyon
tavuk
patates
kuru fasulye
soğan



şeklinde tek kalem olarak yazdırabileceğim bir formül varmı yardımcı olursanız sevinirim
 
Son düzenleme:
Bir modüle aşağıdaki kodları yapıştırınız. DAha sonra bir düğmeye makroyu atayıp, o düğmeyle makroyu çalıştırabilirsiniz:

Kod: 
Sub Makro1()
'
' Makro1 Makro
'

'
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("e1").Select
    ActiveSheet.Paste
        Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("e1").Select
    i = [e65536].End(3).Row
Cells(i + 1, 5).Select
    ActiveSheet.Paste


    Range("C1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("e1").Select
    i = [e65536].End(3).Row
    Cells(i + 1, 5).Select
    ActiveSheet.Paste
    
    Range("D1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("e1").Select
    i = [e65536].End(3).Row
    Cells(i + 1, 5).Select
    ActiveSheet.Paste
    Columns("a:e").EntireColumn.AutoFit
        Range("e1").Select
        Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$E$21").RemoveDuplicates Columns:=5, Header:=xlNo

End Sub
 
Formülle belki olabilir ama bu şekilde daha iyi olur. Ayrıca kodun yinelemeleri kaldıran son bölümünde hata yapmışım. Doğru kod aşağıdaki şekildedir:


Kod: 
Sub Makro1()
'
' Makro1 Makro
'

'
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("e1").Select
    ActiveSheet.Paste
        Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("e1").Select
    i = [e65536].End(3).Row
Cells(i + 1, 5).Select
    ActiveSheet.Paste


    Range("C1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("e1").Select
    i = [e65536].End(3).Row
    Cells(i + 1, 5).Select
    ActiveSheet.Paste
    
    Range("D1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("e1").Select
    i = [e65536].End(3).Row
    Cells(i + 1, 5).Select
    ActiveSheet.Paste
    Columns("a:e").EntireColumn.AutoFit
        Range("e1").Select
        Application.CutCopyMode = False
    ActiveSheet.Range("e:e").RemoveDuplicates Columns:=1, Header:=xlNo

End Sub
 
Bu kodları kopyalayın ve bu listenin olduğu sayfa sekmesine sağ tıklayarak kod görüntüle deyin. Açılan boş sayfaya bu kodları yapıştırın.

Ayrıntılı bilgi için makro ekleme ya da düğmeye makro atama şeklinde arama yapın, yeterli bilgi bulabilirsiniz.
 
Bu arada bu kodları makro bildiğimden değil, makro kaydet yoluyla ve forumda küçük bir araştırma yaparak oluşturdum.

Makro bilmemek problem değil, bir ucundan başlarsanız kısa sürede en azından temel noktalara hakim olabilirsiniz.
 
YA HOCAM
BUTON EKLEDİM AMA
SENİN VERDİĞİN MACROYU BUTONA EKLEYEMEDİM MAKRODAMİ HATA VAR ANLAMADIM
i = [m65536].End(3).Row BUNUN BAŞINDAKİ i = İŞARETİNDE HATA VERİYO SANIRIM
 
Mümkünse hatalı haliyle örnek bir dosya ekleyiniz.
 
Siz kodları hücreye yapıştırmışsınız. Kod sayfasına yapıştırmanız gerekiyordu. Bazı değişiklikler yaptım ama maalesef tam istediğim gibi olmadı. Dosyaya Rapor adlı bir sayfa ekledim ve kodları da aşağıdaki gibi düzenledim ama nasıl oluyorsa arada bir hücreyi boş bırakıyor. Sebebini anlamadım.

Siz en iyisi bu konunun başlığına "çözülmedi" şeklinde ilave yapın da tecrübeli arkadaşlarımız ilgilensinler:

Kod: 
Sub Sırala()
'
' Sırala Makro
'

'
    Sheets("KULLANILAN MALZEMELER").Select
    Range("B7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Rapor").Select
    Range("a1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("KULLANILAN MALZEMELER").Select
    Range("e7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Rapor").Select
    Range("a1").Select
    i = [a65536].End(3).Row
    Cells(i, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("KULLANILAN MALZEMELER").Select
    Range("H7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Rapor").Select
    Range("a1").Select
    i = [a65536].End(3).Row
     Cells(i, 1).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("KULLANILAN MALZEMELER").Select
    Range("K7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Rapor").Select
    Range("a1").Select
    i = [a65536].End(3).Row
        Cells(i, 1).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("a:a").EntireColumn.AutoFit
        Range("a1").Select
        Application.CutCopyMode = False
    ActiveSheet.Range("a:a").RemoveDuplicates Columns:=1, Header:=xlNo

End Sub
 
çözülmedi yardımcı olabilecek arkadas varmı

yardımcı olabilecek arkadas varmı
 
Merhaba,

Aşağıdaki kodu denermisiniz.

Uygulamalı örnek dosya ektedir.


Kod: 
Sub BENZERSİZ_ÜRÜN_LİSTESİ()
    Dim Hücre As Range, Satır As Integer
    
    Range("M7:M" & Rows.Count).ClearContents
    Satır = 7
    
    For Each Hücre In Range("B7:B36,E7:E36,H7:H36,K7:K36")
        If Hücre.Value <> "" Then
            If WorksheetFunction.CountIf(Range("M:M"), Hücre.Value) = 0 Then
                Cells(Satır, "M") = Hücre.Value
                Satır = Satır + 1
            End If
        End If
    Next
    
    Range("M7:M" & Rows.Count).Sort Range("M7"), xlAscending
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 

Ekli dosyalar

Hocam çok teşekkürler çok işime yaradı allah razı olsun
 
çokk teşekkür ederim ilginizen ötürü
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst