Temat: Formatowanie roznej wielkosci tabeli za pomoca makra

witam,

Porzebuje stworzyc makro, ktore:

1. Usunie pierwsze piec rzedow;
2. Obramuje pozostala cala tabele danych o nieznanej ilosci kolumn i wierszy;
3. Sformatuje naglowek tabeli:
• na jakis kolor,
• pogrubi czcionke
• zalozy filtr
4. Zliczy w kolumnie o tytule NETTO (ktora moze znajdowac sie w roznych miejscach) roznice miedzy BRUTTO i VAT. Jesli nie znajdzie takiej kolumny to oczywisice przejdzie dalej
5. Zapisze plik pod ta sama nazwa ale jako .xlsx w katalogu moje dokumenty

Z gory dziekuje za rozwiazania

Temat: Formatowanie roznej wielkosci tabeli za pomoca makra

Panie Jacku,

Tak na szybko:

Sub formatTable()

  Dim r As Integer, r_final As Integer, c As Integer

  Dim varTbl(), varTbl_final()

  Dim lastCol As Integer

  Dim lastRow As Integer

  Dim sFilename As String, sFileDestPath As String

  Dim nettoColPos As Integer, bruttoColPos As Integer, vatColPos As Integer

  

  'Set main variable values

  With Worksheets("Data")

    lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

    

    varTbl = .Cells(1, 1).Resize(lastRow, lastCol).value

  End With

  

  'Set additional variable values

  With Application

    If Not IsError(.Match("Netto", .Index(varTbl, 1), 0)) Then _

      nettoColPos = .Match("Netto", .Index(varTbl, 1), 0) Else nettoColPos = -1

    

    If Not IsError(.Match("Brutto", .Index(varTbl, 1), 0)) Then _

      bruttoColPos = .Match("Brutto", .Index(varTbl, 1), 0) Else bruttoColPos = -1

    

    If Not IsError(.Match("Vat", .Index(varTbl, 1), 0)) Then _

      vatColPos = .Match("Vat", .Index(varTbl, 1), 0) Else vatColPos = -1

  End With

  

  'Set varTbl_final row counter

  r_final = 1

  

  'If there is enough rows to remove first 5

  If lastRow > 6 Then

    ReDim Preserve varTbl_final(1 To lastRow - 5, 1 To lastCol)

    

    For r = 1 To lastRow

      If r = 2 Then r = 7   'jump to 6th row with data

      

      For c = 1 To lastCol

        varTbl_final(r_final, c) = varTbl(r, c)

      Next c

      

      'calculate netto column value if it's possible

      If nettoColPos <> -1 And bruttoColPos <> -1 And vatColPos <> -1 And r >= 7 Then

        varTbl_final(r_final, nettoColPos) = varTbl_final(r_final, bruttoColPos) - varTbl_final(r_final, vatColPos)

      End If

      'increment varTbl_final row counter

      r_final = r_final + 1

    Next r

    

    

    With Worksheets("Data")

      .Cells.Clear

      With .Cells(1, 1)

        .Resize(UBound(varTbl_final), lastCol) = varTbl_final

        .Resize(UBound(varTbl_final), lastCol).Borders.LineStyle = xlContinuous

        With .Resize(1, lastCol)

          .Interior.Color = RGB(200, 100, 255)

          .Font.Bold = True

          .AutoFilter

        End With

      End With

    End With

    

    'save file

    sFilename = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))

    sFileDestPath = "C:\Documents and Settings\VM_WinXP_admin\My Documents\"

    ThisWorkbook.SaveAs sFileDestPath & sFilename, xlOpenXMLWorkbook

  End If  'END If there is enough rows to remove first 5

End Sub

Dane bazowe są pobierane z arkusza o nazwie "Data" poczynając od komórki A1.
W przypadku, kiedy ilość danych nie pozwala na usunięcie pierwszych 5 wierszy kod nic nie zrobi.

Pozdrawiam

Temat: Formatowanie roznej wielkosci tabeli za pomoca makra

Można sobie jeszcze ułatwić życie robiąc z "rysowanej" tabeli excela, obiekt tabeli excela.