< návrat zpět
MS Excel
Téma: Vytvoreni filtrovaneho seznamu od urciteho radku 
Zaslal/a Zdenek84 3.12.2014 9:24
Ahoj, potreboval bych poradit s upravou jednoho makrem, jehoz nejsem autorem a autora ani neznam.
Makro bere hodnody z tabulky, ze 2 sheetu a vytvari novy soubor, kam ty hodnoty uklada. V novem souboru jsou jinak pojmenovane sloupce, maji jine poradi, formatovani atd. Muj problem je v tom, ze v puvodnim seznamu mela halavicka 2 nebo radky, ktere mely ruzne slucene bunky. Aktualni tabulka (zdrojova) uz ma jen jeden radek, bez jakychkoliv slouceni.
A ted konecne k memu problemu: pri vygenerovani nove tabulky tam chybi jeden (prvni) radek hodnot. Vim, ze to bude asi pomerne jednoducha uprava, ale prochazel jsem to makro nekolikrat, ale me znalosti vba jsou dost chabe na to, abych to opravil sam. Prosim tedy o nejake nasmerovani, co bych tam mel hledat.
Bohuzel nemuzu poskytnout cely soubor, ale dam sem aspon kousek toho makra, kde by podle me mohl byt problem:
Sub Generate_APAR_list()
ActiveFileName = ActiveWorkbook.Name
sheet_source = "APAR default"
sheet_target = "APAR"
sheet_status = "Status report"
sheet_approvers = "Add_approvers"
Dim i As Integer
'vypnuti filtrovani ve status reportu, APAR default
Worksheets(sheet_status).Rows(3).AutoFilter
Worksheets(sheet_source).Rows(2).AutoFilter
'pocet servru v APAR
pocet_APAR = 1
NajdiKonec pocet_APAR, 1, sheet_source
'****************************************
'kopiruje seznam servru
For i = 3 To pocet_APAR
Worksheets(sheet_target).Cells(i, 1).Value = Worksheets(sheet_source).Cells(i, 1).Value
Next i
'kopiruje responsible
For i = 3 To pocet_APAR
j = Worksheets(sheet_status).Columns(1).Find(Worksheets(sheet_target).Cells(i, 1).Value, LookIn:=xlValues).Address
j = Application.WorksheetFunction.Replace(j, 1, 3, "")
k = Val(j)
Worksheets(sheet_target).Cells(i, 4).Value = Worksheets(sheet_status).Cells(k, 5).Value
Next i
'zapnuti filtrovani ve status reportu, APAR default
Worksheets(sheet_status).Rows(3).AutoFilter
Worksheets(sheet_status).Rows(3).AutoFilter Field:=12, Criteria1:="<>0", Operator:=xlAnd, Criteria2:="<>3"
Worksheets(sheet_source).Rows(2).AutoFilter
Worksheets(sheet_target).Rows(2).AutoFilter
Worksheets(sheet_target).Rows(2).AutoFilter Field:=11, Criteria1:="<>-", Operator:=xlAnd
Worksheets(sheet_target).Cells(3, 2).Activate
ActiveWindow.FreezePanes = True
'nastavi podminene formatovani
Worksheets(sheet_target).Range(Cells(2, 10), Cells(pocet_APAR + 20, 10)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""x"""
Worksheets(sheet_target).Range(Cells(2, 10), Cells(pocet_APAR + 20, 10)).FormatConditions(1).Interior.ColorIndex = 4
Worksheets(sheet_target).Range(Cells(2, 10), Cells(pocet_APAR + 20, 10)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""-"""
Worksheets(sheet_target).Range(Cells(2, 10), Cells(pocet_APAR + 20, 10)).FormatConditions(2).Interior.ColorIndex = 3
Worksheets(sheet_target).Range(Cells(2, 19), Cells(pocet_APAR + 20, 19)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""x"""
Worksheets(sheet_target).Range(Cells(2, 19), Cells(pocet_APAR + 20, 19)).FormatConditions(1).Interior.ColorIndex = 4
Worksheets(sheet_target).Range(Cells(2, 19), Cells(pocet_APAR + 20, 19)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""-"""
Worksheets(sheet_target).Range(Cells(2, 19), Cells(pocet_APAR + 20, 19)).FormatConditions(2).Interior.ColorIndex = 3
Worksheets(sheet_target).Range(Cells(2, 20), Cells(pocet_APAR + 20, 20)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""x"""
Worksheets(sheet_target).Range(Cells(2, 20), Cells(pocet_APAR + 20, 20)).FormatConditions(1).Interior.ColorIndex = 4
Worksheets(sheet_target).Range(Cells(2, 20), Cells(pocet_APAR + 20, 20)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""-"""
Worksheets(sheet_target).Range(Cells(2, 20), Cells(pocet_APAR + 20, 20)).FormatConditions(2).Interior.ColorIndex = 3
Worksheets(sheet_target).Copy
Workbooks(ActiveFileName).Activate
Application.DisplayAlerts = False
Worksheets(sheet_target).Delete
Application.DisplayAlerts = True
Pouzivam excel 2013, ale makro bylo vytvareno v 2003.
Predem moc dekuji za veskere rady
Pavlus(10.12.2014 13:34)#022726 
Měl bys tam hledat něco, co určuje, že se bude daná akce provádět od třetího řádku :-). S tím, že to musíš opravit na řádek druhý...
Jeden problém bude zřejmě v "For i = 3", máš to tam dvakrát, oprav na "For i = 2".
Jinak bez zdroje se dost těžko radí... Případně ještě projdi další části kódu. Např. to filtrování asi ještě bude třeba upravit. Řádek je anglicky "row" a v závorce máš číslo řádku...
P.
citovat
RSS nejnovější články