• FORUMU MOBİL UYGULAMADAN TAKİP EDİN

    Forumu isteyen üyelerimiz Tapatalk (Harici bir hizmet) üzerinden mobil uygulamadan takip edebilirler.
    iOS için : https://itunes.apple.com/app/id307880732?mt=8
    Android için : https://play.google.com/store/apps/details?id=com.quoord.tapatalkpro.activity
    adreslerinden indirebilirsiniz.

    Bir iki haftaya da foruma özel kendi uygulamamız yayında olacak.
ALTIN ÜYELİK Hakkında Bilgi
-----------------------

çoklu sütun değerlerini tek bir sütuna nasıl getirilir

KMLZDMR

Altın Üye
Altın Üye
Katılım
9 Nisan 2015
Mesajlar
425
Beğeniler
3
Excel Vers. ve Dili
2003 TÜRKÇE EXCEL
#1
Merhaba
çoklu sütun değerlerini tek bir sütuna nasıl getirilir. (excel 2003)
Ekli dosyada E1:K50 aralığındaki veri alanını esas alınmak üzere;
a) O sütununa "TÜR" P sütununa "TİP" gelmek üzere ekli dosyada P sütununa "TİP" manuel geldiği üzere sırasıyla TÜR ve Sayfa alanları formül ile nasıl getirilebilir?
b) U sütununa "TÜR" V sütununa "TİP" gelmek üzere ekli dosyada 6 sütundan oluşan "TİP" satırlara dağıtılarak tür ve sayfa alan değerleri formül ile nasıl getirilebilir?

lütfen yardımcı olabilir misiniz?
 

Ekli dosyalar

Ziynettin

Altın Üye
Altın Üye
Katılım
17 Nisan 2008
Mesajlar
584
Beğeniler
34
Excel Vers. ve Dili
office2010
#2
Merhaba,

[O:Q] tablonuz için.

Kod:
Sub test_tablo1()
a = Range("E1:K" & Cells(Rows.Count, 5).End(3).Row).Value
    ReDim b(1 To UBound(a) * 6, 1 To 3)
    For j = 1 To 6
        sut = j + 1
        For i = 2 To UBound(a)
            say = say + 1
            b(say, 1) = a(i, 1)
            b(say, 2) = a(1, sut)
            b(say, 3) = a(i, sut)
        Next i
    Next j
Range("O2:Q" & Rows.Count).ClearContents
If say > 0 Then
    [O2].Resize(say, 3) = b
    MsgBox "İşlem tamam", vbInformation
Else
    MsgBox "İşlem yok", vbCritical
End If
End Sub

[U:W] tablonuz için.

Kod:
Sub test_tablo2()
Set d = CreateObject("scripting.dictionary")
a = Range("E1:K" & Cells(Rows.Count, 5).End(3).Row).Value
    For i = 1 To UBound(a): d(a(i, 1)) = "": Next i
    ReDim b(1 To UBound(a) * 6, 1 To 3)
        For Each v In d.keys
            For i = 2 To UBound(a)
                For j = 1 To 6
                    sut = j + 1
                    If a(i, 1) = v Then
                        say = say + 1
                        b(say, 1) = a(i, 1)
                        b(say, 2) = a(1, sut)
                        b(say, 3) = a(i, sut)
                    End If
                Next j
            Next i
        Next v
    Range("U2:W" & Rows.Count).ClearContents
    If say > 0 Then
        [U2].Resize(say, 3) = b
        MsgBox "İşlem tamam", vbInformation
    Else
        MsgBox "İşlem yok", vbCritical
    End If
End Sub
 

KMLZDMR

Altın Üye
Altın Üye
Katılım
9 Nisan 2015
Mesajlar
425
Beğeniler
3
Excel Vers. ve Dili
2003 TÜRKÇE EXCEL
#3
Sayın Ziynettin teşekkür ederim.
Formülle yapmaya ihtiyacım var...
Formülle yapacak arkadaşlardan destek bekliyorum..
 
Üst