ç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
442
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

Katılım
17 Nisan 2008
Mesajlar
626
Beğeniler
58
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
442
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