• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

sütun-satır sadeleştirme

  • Konbuyu başlatan Konbuyu başlatan enfal
  • Başlangıç tarihi Başlangıç tarihi
E

enfal

Katılım
23 Ocak 2007
Mesajlar
47
Excel Vers. ve Dili
2000
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
    fr.xls
    23 KB · Görüntüleme: 11
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
 
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.
 
VErdiğim kodu denediniz mi? Sonuç nasıl?
 
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
 
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.
Geri
Üst