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

KMLZDMR

Altın Üye
Katılım
9 Nisan 2015
Mesajlar
494
Excel Vers. ve Dili
2003 TÜRKÇE EXCEL
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

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,104
Excel Vers. ve Dili
office2010
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
Katılım
9 Nisan 2015
Mesajlar
494
Excel Vers. ve Dili
2003 TÜRKÇE EXCEL
Sayın Ziynettin teşekkür ederim.
Formülle yapmaya ihtiyacım var...
Formülle yapacak arkadaşlardan destek bekliyorum..
 
Üst