sütun-satır sadeleştirme

E

enfal

Katılım
23 Ocak 2007
Mesajlar
47
Excel Vers. ve Dili
2000
Altın Üyelik Bitiş Tarihi
06-02-2020
Aşağıda örnek bir dosya gönderdim buradaki sütunlar çok karmaşık gizli olanlar var çok birbirine girmiş olanlar var vs. bunları tek bir satır veya sütuna indirgemek için yardımcı olabilir misiniz ?
 

Ekli dosyalar

  • fr.xls
    23 KB Görüntüleme: 11
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Tam olarak istediğiniz gibi olmadı muhtemelen ancak aşağıdaki kodları makro kaydet yoluyla elde ettim ve biraz değiştirdim. A:X sütunlarında 100 satırlık alan için işlem yapar. Deneyin:

PHP: 
Sub Makro1()
'
' Makro1 Makro
'

'
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("A:X").Select
    Selection.UnMerge
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("A:X").EntireColumn.AutoFit
    Cells.Select
    Cells.EntireRow.AutoFit
    Columns("A:AB").Select
    Selection.ColumnWidth = 10
    Columns("A:AB").EntireColumn.AutoFit
    For i = 1 To 30
        If WorksheetFunction.CountA(Range(Cells(1, i), Cells(Rows.Count, i))) = 0 Then
            Columns(i).Delete
        End If
    Next
    For j = 300 To 1 Step -1
        If WorksheetFunction.CountA(Range(Cells(j, "A"), Cells(j, "AB"))) = 0 Then
            Rows(j).Delete
        End If
    Next
End Sub
 
E

enfal

Katılım
23 Ocak 2007
Mesajlar
47
Excel Vers. ve Dili
2000
Altın Üyelik Bitiş Tarihi
06-02-2020
YUSUF44' Alıntı:
Tam olarak istediğiniz gibi olmadı muhtemelen ancak aşağıdaki kodları makro kaydet yoluyla elde ettim ve biraz değiştirdim. A:X sütunlarında 100 satırlık alan için işlem yapar. Deneyin:

PHP: 
Sub Makro1()
'
' Makro1 Makro
'

'
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("A:X").Select
    Selection.UnMerge
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("A:X").EntireColumn.AutoFit
    Cells.Select
    Cells.EntireRow.AutoFit
    Columns("A:AB").Select
    Selection.ColumnWidth = 10
    Columns("A:AB").EntireColumn.AutoFit
    For i = 1 To 30
        If WorksheetFunction.CountA(Range(Cells(1, i), Cells(Rows.Count, i))) = 0 Then
            Columns(i).Delete
        End If
    Next
    For j = 300 To 1 Step -1
        If WorksheetFunction.CountA(Range(Cells(j, "A"), Cells(j, "AB"))) = 0 Then
            Rows(j).Delete
        End If
    Next
End Sub
Genişletmek için tıkla ...

BEN BU TİP DOSYALARI MUHASEBE PROGRAMINDAN ÇEKİYORUM O YÜZDEN BÖYLE KARMAŞIK ÇIKIYOR SADELEŞTİRMEM LAZIM SATIR VE SÜTÜN OLARAK.
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
VErdiğim kodu denediniz mi? Sonuç nasıl?
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodu deneyin. Size uymuyorsa nerede ne gibi değişiklik yapılması gerektiğini belirtin:

PHP: 
Sub Makro1()
'
' Makro1 Makro
'

'
    Cells.Borders(xlDiagonalDown).LineStyle = xlNone
    Cells.Borders(xlDiagonalUp).LineStyle = xlNone
    Cells.Borders(xlEdgeLeft).LineStyle = xlNone
    Cells.Borders(xlEdgeTop).LineStyle = xlNone
    Cells.Borders(xlEdgeBottom).LineStyle = xlNone
    Cells.Borders(xlEdgeRight).LineStyle = xlNone
    Cells.Borders(xlInsideVertical).LineStyle = xlNone
    Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Cells.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("A:X").UnMerge
    With Columns("A:X").Columns("A:X")
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("A:X").EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    Columns("A:AB").ColumnWidth = 10
    Columns("A:AB").EntireColumn.AutoFit
    Range("E4").Cut Range("C4")
    Range("F3").Cut Range("C3")
    Range("B9").Cut Range("C9")
    Range("M9:Q9").Cut Range("N9")
    a = Cells(Rows.Count, "D").End(3).Row
    Range("D" & a & ":S" & a).Cut Range("C" & a)
    Rows("5:7").Delete
    
    For i = 1 To 30
        If WorksheetFunction.CountA(Range(Cells(1, i), Cells(Rows.Count, i))) = 0 Then
            Columns(i).Delete
        End If
    Next
    For j = 300 To 1 Step -1
        If WorksheetFunction.CountA(Range(Cells(j, "A"), Cells(j, "AB"))) = 0 Then
            Rows(j).Delete
        End If
    Next
    Range("J:J").Delete
    Range("F:H").Delete
    Range("C:D").Delete
    Rows("1:2").Delete
    Range("B1:E1").Merge
    Range("B2:E2").Merge
    Columns("B:E").ColumnWidth = 15
    
    
    With Range("B1:E2")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    sonb = Cells(Rows.Count, "B").End(3).Row
    
    Range("B3:E" & sonb).Borders(xlDiagonalDown).LineStyle = xlNone
    Range("B3:E" & sonb).Borders(xlDiagonalUp).LineStyle = xlNone
    With Range("B3:E" & sonb).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E" & sonb).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E" & sonb).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E" & sonb).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E" & sonb).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Range("B3:E" & sonb).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Range("B3:E3").Borders(xlDiagonalDown).LineStyle = xlNone
    Range("B3:E3").Borders(xlDiagonalUp).LineStyle = xlNone
    With Range("B3:E3").Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E3").Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E3").Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E3").Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E3").Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Range("B3:E3").Borders(xlInsideHorizontal).LineStyle = xlNone
    
    Range("B" & sonb & ":E" & sonb).Borders(xlDiagonalDown).LineStyle = xlNone
    Range("B" & sonb & ":E" & sonb).Borders(xlDiagonalUp).LineStyle = xlNone
    With Range("B" & sonb & ":E" & sonb).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B" & sonb & ":E" & sonb).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B" & sonb & ":E" & sonb).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B" & sonb & ":E" & sonb).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B" & sonb & ":E" & sonb).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Range("B" & sonb & ":E" & sonb).Borders(xlInsideHorizontal).LineStyle = xlNone
    With Columns("B:E")
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Rows("1").RowHeight = 50

End Sub
 
E

enfal

Katılım
23 Ocak 2007
Mesajlar
47
Excel Vers. ve Dili
2000
Altın Üyelik Bitiş Tarihi
06-02-2020
YUSUF44' Alıntı:
Aşağıdaki kodu deneyin. Size uymuyorsa nerede ne gibi değişiklik yapılması gerektiğini belirtin:

PHP: 
Sub Makro1()
'
' Makro1 Makro
'

'
    Cells.Borders(xlDiagonalDown).LineStyle = xlNone
    Cells.Borders(xlDiagonalUp).LineStyle = xlNone
    Cells.Borders(xlEdgeLeft).LineStyle = xlNone
    Cells.Borders(xlEdgeTop).LineStyle = xlNone
    Cells.Borders(xlEdgeBottom).LineStyle = xlNone
    Cells.Borders(xlEdgeRight).LineStyle = xlNone
    Cells.Borders(xlInsideVertical).LineStyle = xlNone
    Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Cells.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("A:X").UnMerge
    With Columns("A:X").Columns("A:X")
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("A:X").EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    Columns("A:AB").ColumnWidth = 10
    Columns("A:AB").EntireColumn.AutoFit
    Range("E4").Cut Range("C4")
    Range("F3").Cut Range("C3")
    Range("B9").Cut Range("C9")
    Range("M9:Q9").Cut Range("N9")
    a = Cells(Rows.Count, "D").End(3).Row
    Range("D" & a & ":S" & a).Cut Range("C" & a)
    Rows("5:7").Delete
   
    For i = 1 To 30
        If WorksheetFunction.CountA(Range(Cells(1, i), Cells(Rows.Count, i))) = 0 Then
            Columns(i).Delete
        End If
    Next
    For j = 300 To 1 Step -1
        If WorksheetFunction.CountA(Range(Cells(j, "A"), Cells(j, "AB"))) = 0 Then
            Rows(j).Delete
        End If
    Next
    Range("J:J").Delete
    Range("F:H").Delete
    Range("C:D").Delete
    Rows("1:2").Delete
    Range("B1:E1").Merge
    Range("B2:E2").Merge
    Columns("B:E").ColumnWidth = 15
   
   
    With Range("B1:E2")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    sonb = Cells(Rows.Count, "B").End(3).Row
   
    Range("B3:E" & sonb).Borders(xlDiagonalDown).LineStyle = xlNone
    Range("B3:E" & sonb).Borders(xlDiagonalUp).LineStyle = xlNone
    With Range("B3:E" & sonb).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E" & sonb).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E" & sonb).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E" & sonb).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E" & sonb).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Range("B3:E" & sonb).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Range("B3:E3").Borders(xlDiagonalDown).LineStyle = xlNone
    Range("B3:E3").Borders(xlDiagonalUp).LineStyle = xlNone
    With Range("B3:E3").Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E3").Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E3").Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E3").Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B3:E3").Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Range("B3:E3").Borders(xlInsideHorizontal).LineStyle = xlNone
   
    Range("B" & sonb & ":E" & sonb).Borders(xlDiagonalDown).LineStyle = xlNone
    Range("B" & sonb & ":E" & sonb).Borders(xlDiagonalUp).LineStyle = xlNone
    With Range("B" & sonb & ":E" & sonb).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B" & sonb & ":E" & sonb).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B" & sonb & ":E" & sonb).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B" & sonb & ":E" & sonb).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B" & sonb & ":E" & sonb).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Range("B" & sonb & ":E" & sonb).Borders(xlInsideHorizontal).LineStyle = xlNone
    With Columns("B:E")
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Rows("1").RowHeight = 50

End Sub
Genişletmek için tıkla ...
Çok teşekkür ederim şu an için işimi görüyor. İhtiyaç olursa başka bir durumda belirtilim inşaAllah
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst