Makro ile transpose yapma

[snmaybkehr]

Merhabalar,

Elimde bir data var ve bu datayı tamamen çevirmek istiyorum ( bu verileri sql server'a import etmem gerektiği için tüm kolonların sabit olması gerekli ve bu gönderilen datadaki kolonlar her seferinde farklılaşıyor ben de bu yüzden "Dsn Bayi" kolonunun prim çeşidi kadar tekrar etmesini ve her bayi için prim çeşitlerinin tekrarlanmasını istiyorum )

İlk tablo gönderilen data, ikincisi ise çevirmek istediğm format. Makro ile birkaç şey denedim ama ne yaptıysam beceremedim çok mu zor bir şey istiyorum anlamadım

[TABLE]

Dsn bayi

ASKERCELL PRİMİ EYLÜL

ÜST TARİFEYE GEÇİŞ PRİMİ KASIM

ÜST TARİFEYE GEÇİŞ PRİMİ SARKAN AĞUSTOS

GELİR SARKAN AĞUSTOS

PERAKENDECİLİK PRİMİ KASIM

PERAKENDECİLİK PRİMİ SARKAN EKİM

PERAKENDECİLİK PRİMİ SARKAN EYLÜL

KALİTELİ YÜKSEK ÖN ÖDEMELİ PRİMİ EKİM

RAHAT GELİR AVANS AĞUSTOS

RAHAT BAZ PRİM AVANS EYLÜL

BAZ PRİM SARKAN ÖN ÖDEMELİ EYLÜL

BAZ PRİM SARKAN FATURALI EYLÜL

ÖN ÖDEMELİ HAT İPTAL UYGULAMASI EKİM

RAHAT İPTAL UYGULAMASI EKİM

FATURALI İPTAL KESİNTİSİ MAYIS

DSN KESİLEMEYEN KASIM

GELIR PRIMI AVANS TURKCELL KASIM

AKTİVASYON TEŞVİK AVANS KASIM

BAZ PRIM ON ODEMELI KASIM

BAZ PRIM FATURALI KASIM

00000.B7580

0 TL

0 TL

0 TL

0 TL

4.800 TL

0 TL

0 TL

900 TL

0 TL

0 TL

1.987 TL

-90 TL

-280 TL

0 TL

0 TL

0 TL

5.191 TL

625 TL

6.600 TL

386 TL

00000.17400

0 TL

31 TL

199 TL

2.752 TL

4.400 TL

0 TL

0 TL

0 TL

7 TL

86 TL

66 TL

606 TL

0 TL

0 TL

0 TL

0 TL

2.138 TL

2.644 TL

1.375 TL

3.843 TL

[/TABLE]

Fakat bana aşağıdaki gibi bir data lazım,

[TABLE]

Bayi

Prim Cesit

Prim Tutar

00000.B7580

ASKERCELL PRİMİ EYLÜL

0 TL

00000.B7580

ÜST TARİFEYE GEÇİŞ PRİMİ KASIM

0 TL

00000.B7580

ÜST TARİFEYE GEÇİŞ PRİMİ SARKAN AĞUSTOS

0 TL

00000.B7580

GELİR SARKAN AĞUSTOS

0 TL

00000.B7580

PERAKENDECİLİK PRİMİ KASIM

4.800 TL

00000.B7580

PERAKENDECİLİK PRİMİ SARKAN EKİM

0 TL

00000.B7580

PERAKENDECİLİK PRİMİ SARKAN EYLÜL

0 TL

00000.B7580

KALİTELİ YÜKSEK ÖN ÖDEMELİ PRİMİ EKİM

900 TL

00000.B7580

RAHAT GELİR AVANS AĞUSTOS

0 TL

00000.B7580

RAHAT BAZ PRİM AVANS EYLÜL

0 TL

00000.B7580

BAZ PRİM SARKAN ÖN ÖDEMELİ EYLÜL

1.987 TL

00000.B7580

BAZ PRİM SARKAN FATURALI EYLÜL

-90 TL

00000.B7580

ÖN ÖDEMELİ HAT İPTAL UYGULAMASI EKİM

-280 TL

00000.B7580

RAHAT İPTAL UYGULAMASI EKİM

0 TL

00000.B7580

FATURALI İPTAL KESİNTİSİ MAYIS

0 TL

00000.B7580

DSN KESİLEMEYEN KASIM

0 TL

00000.B7580

GELIR PRIMI AVANS TURKCELL KASIM

5.191 TL

00000.B7580

AKTİVASYON TEŞVİK AVANS KASIM

625 TL

00000.B7580

BAZ PRIM ON ODEMELI KASIM

6.600 TL

00000.B7580

BAZ PRIM FATURALI KASIM

386 TL

[/TABLE]

 

[Ömer]

Merhaba,

Sorunuzu örnek dosya ekleyerek açıklayınız. Eski veri olması gereken düzen şeklinde.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

 

[snmaybkehr]

Merhaba,

Dosyayı yükledim. https://dosya.co/r6br0pp3bq3f/Dosya.xlsx.html

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Transpose_Table()
    Dim S1 As Worksheet, S2 As Worksheet, Veri As Variant, Baslik As Variant
    Dim Son As Long, X As Long, Y As Byte, Say As Long, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("Gelen Data")
    Set S2 = Sheets("Olması Gereken")
    
    S2.Range("A2:C" & S2.Rows.Count).Clear
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son <= 2 Then Son = 3
    
    Veri = S1.Range("A2:W" & Son).Value2
    Baslik = S1.Range("D1:" & S1.Cells(1, S1.Columns.Count).End(1).Address(0, 0)).Value
    
    ReDim Liste(1 To (Son - 1) * UBound(Baslik, 2), 1 To 3)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        For Y = LBound(Baslik, 2) To UBound(Baslik, 2)
            Say = Say + 1
            Liste(Say, 1) = Veri(X, 1)
            Liste(Say, 2) = Baslik(1, Y)
            Liste(Say, 3) = Veri(X, Y + 3)
        Next
    Next
    
    If Say > 0 Then
        S2.Range("A2").Resize(Say, 1).NumberFormat = "@"
        S2.Range("A2").Resize(Say, 3) = Liste
        S2.Range("A2").Resize(Say, 3).Borders.LineStyle = 1
        S2.Columns.AutoFit
        MsgBox "İşleminiz tamamlanmıştır." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        MsgBox "Uygun kayıt bulunamadı!", vbExclamation
    End If
    
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[snmaybkehr]

Çok teşekkürler, tam istediğim şey oldu.

Adres verin çiçek yollayacağım