Makro ile transpose yapma

Katılım
13 Ocak 2021
Mesajlar
3
Excel Vers. ve Dili
Microsoft Office Professional Plus 2013 Türkçe
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

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
20,671
Excel Vers. ve Dili
2016-Türkçe
Merhaba,

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

 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
30,262
Excel Vers. ve Dili
OFFICE 2019 PRO TR
Deneyiniz.

C++:
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
 
Katılım
13 Ocak 2021
Mesajlar
3
Excel Vers. ve Dili
Microsoft Office Professional Plus 2013 Türkçe
Çok teşekkürler, tam istediğim şey oldu.

Adres verin çiçek yollayacağım :):)
 
Üst