yatay dikey

[aleysan]

herkese merhaba
ekteki excel dosyasında bir müşteriye ait bilgiler ve müşteriye ait tutarlar var
L1,L2,L3,,,,,L12
K1,K2,K3,,,,K12
F1,F2,F3,,,,F12 GİBİ 36 SUTUNDA DA RAKAMALAR VAR .
BU LİSTEYİ SAYFA 2 DEKİ ÖRNEKTE ODUĞU GİBİ (ÇAPRAZ) L,K,F, LER SÜTUN 1,2,3,4,,,,,,12 SATIRLARDA GÖSTERMEK İSTİYORUM
YANİ BİR MÜŞTERİ LİSTEDE BİRKEZ VARKEN ŞİMDİ 12 KEZ OLCAK AMA HEPSİNİN KARŞISINDA 1DEN 12 E KADAR RAKAMLAR OLCAK
HERKESE KOLAY GELSİN

 

[Serdar SELEN]

Merhaba,

Aşağıdaki formülü E3 hücresine kopyalayarak sağa ve aşağıya doğru sürükleyiniz.

=INDEX('SAYFA 1'!$A$2:$AM$499;MATCH(SAYFA2!$A3;'SAYFA 1'!$A$2:$A$499;0);MATCH(SAYFA2!E$2&SAYFA2!$D3;'SAYFA 1'!$A$2:$AM$2;0))

İyi çalışmalar

 

[aleysan]

merhabalar
ilginize teşekkür ederim
söylediğiniz işlemi yaptım fakat olmuyor.
güncelleştirilecek yer soruyor ilgili tabloyu seçiyorum fakat hata veriyor.
kaçırdığım bir yer olabilir.
siz ekteki örneğe uygulayıp güncelleyebilir veya yeniden ekleyebilirseniz çok daha memnun olacam teşekkür ederim kolay gelsin

 

[mancubus]

merhaba.

ekteki dosyayı inceleyiniz.

dosyada yer alan aşğıdaki makroyu çalıştırdıktan sonra kontrol ediniz.
makroyu çalıştırmadan önce asıl dosyanızın bir örneğini alınız.
veya verilerinizi ekteki dosyada "input" isimli sayfaya kopyalayarak deneyiniz.

ilk 3 sütunu sabit tutarak diğer sütunların tek tek eklendiği yeni bir tablo olşuturuyor.
pivot tablo yardımı ile organize ediyor.

muhtelif kaynaklardan derlediğim kodlardan bir kolaj oldu

Sub multicol_to_4col()

Dim iRow As Long, iCol As Long, iTargetRow As Long
Dim wsi As Worksheet, wso As Worksheet

On Error Resume Next

Set wsi = Sheets("input")
Set wso = Sheets("output")

wso.Cells.Clear

LR = wsi.Cells(Rows.Count, 1).End(3).Row
LC = wsi.Cells(1, Columns.Count).End(1).Column

iTargetRow = 2
For iCol = 4 To LC
    For iRow = 2 To LR
        wso.Cells(iTargetRow, 1) = wsi.Cells(iRow, 1)
        wso.Cells(iTargetRow, 2) = wsi.Cells(iRow, 2)
        wso.Cells(iTargetRow, 3) = wsi.Cells(iRow, 3)
        wso.Cells(iTargetRow, 4) = wsi.Cells(iRow, iCol)
        wso.Cells(iTargetRow, 5) = wsi.Cells(1, iCol)
        iTargetRow = iTargetRow + 1
    Next
Next
    
wso.Columns(5).TextToColumns Destination:=Range("E1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(1, 1)), TrailingMinusNumbers:=True

wso.Cells(1, 1) = "Müşteri No"
wso.Cells(1, 2) = "Bayi No"
wso.Cells(1, 3) = "Bayi Adı"
wso.Cells(1, 4) = "Tutar"
wso.Cells(1, 5) = "Harf_Kod"
wso.Cells(1, 6) = "Rakam_Kod"


Dim ws As Worksheet
For Each ws In Worksheets
    If ws.Name = "pvt" Then
        Application.DisplayAlerts = False
        Sheets("pvt").Delete
        Application.DisplayAlerts = True
    End If
Next

LR = 0
LC = 0

wso.Activate
LR = wso.Cells(Rows.Count, 1).End(3).Row
LC = wso.Cells(1, Columns.Count).End(1).Column
Dim rng As Range
Set rng = Sheets("output").Range(Cells(1, 1), Cells(LR, LC))

Sheets.Add(After:=Sheets("output")).Name = "pvt"
Sheets("pvt").Activate
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    rng).CreatePivotTable TableDestination:= _
    "[cok_sütun_4sütun.xls]pvt!R1C1", TableName:="PivotTable1", DefaultVersion _
    :=xlPivotTableVersion10
ActiveSheet.PivotTables("PivotTable1").AddFields RowFields:=Array( _
    "Müşteri No", "Bayi No", "Rakam_Kod"), ColumnFields:="Harf_Kod"
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Tutar")
    .Orientation = xlDataField
    .Caption = "Sum of Tutar"
    .Function = xlSum
End With
With ActiveSheet.PivotTables("PivotTable1")
    .ColumnGrand = False
    .RowGrand = False
End With

Dim pt As PivotTable
Dim pf As PivotField
For Each pt In ActiveSheet.PivotTables
  For Each pf In pt.PivotFields
    pf.Subtotals(1) = True
    pf.Subtotals(1) = False
  Next pf
Next pt

For Each ws In Worksheets
    If ws.Name = "son" Then
        Application.DisplayAlerts = False
        Sheets("son").Delete
        Application.DisplayAlerts = True
    End If
Next

Sheets.Add(After:=Sheets("pvt")).Name = "son"

Sheets("pvt").Range("A2:F25000").Copy
Sheets("son").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


For Each ws In Worksheets
    If ws.Name = "pvt" Then
        Application.DisplayAlerts = False
        Sheets("pvt").Delete
        Application.DisplayAlerts = True
    End If
Next

Sheets("son").Activate

Dim Area As Range, LastRow As Long
On Error Resume Next
Range("A1").Select
LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, _
             SearchDirection:=xlPrevious, _
             LookIn:=xlFormulas).Row
For Each Area In ActiveCell.EntireColumn(1).Resize(LastRow). _
             SpecialCells(xlCellTypeBlanks).Areas
          Area.Value = Area(1).Offset(-1).Value
Next

Range("B1").Select
LastRow = 0
LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, _
             SearchDirection:=xlPrevious, _
             LookIn:=xlFormulas).Row
For Each Area In ActiveCell.EntireColumn(1).Resize(LastRow). _
             SpecialCells(xlCellTypeBlanks).Areas
          Area.Value = Area(1).Offset(-1).Value
Next

Columns("C:C").Insert Shift:=xlToRight
Range("C1") = "Bayi Adı"
Range("C2:C" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-1],input!C[-1]:C,2,0)"
With Range("C2:C" & Range("B65536").End(xlUp).Row)
    .Value = .Value
End With


End Sub

 

[aleysan]

selam

hocam çok teşşekkür ederim kod L olanlar SON sayfada gelmedi ama olsun okadarını önceki sayfadan alırım heralde teşekkür ederim çok makbule geçti.
elinize emeğinize sağlık.
hoşçakalın.

 

[mancubus]

rica ederim.

çözümü eklerken problem olmamıştı.
şimdi tekrar denedim. aynı hatayı bende de yaptı. makroyu tekrar çalıştırdığımda problem olmadı.


aşağıdaki kod ile gerçekleşen metni sütunlara dönüştür işlevi sırasında bir hata oluyor anladığım kadarı ile.

wso.Columns(5).TextToColumns Destination:=Range("E1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(1, 1)), TrailingMinusNumbers:=True

şöyle bir şey deneyebilir misiniz?

tüm verilerin olduğu ilk sayfadaki başlıkları
L1, L2,..., L9 -> L01, L02,..., L09'a
K1, K2,..., K9 -> K01, K02,..., K09'a
F1, F2,..., F9 -> F01, F02,..., F09'a
dönüştürebilir misiniz?

böylece 10, 11 ve 12 ile bitenler gibi 3 basamaklı olsun hepsi.

 

[aleysan]

teşekkür ederim
sorun çözülmüştür. kolay gelsin