Sub Testuj
Dim Doc, Sheet, Cell1, Cell2, Cell3, Cell4 As Object
Dim iEnd as long
Doc = ThisComponent
iEnd = GetLastRow
Sheet = Doc.Sheets(0) 'číslo listu 0 = první list
For i = iEnd To 1 Step - 1
Cell1 = Sheet. getCellByPosition (0, i) 'start ve 3. sloupci (C), 1. řádek
Cell2 = Sheet. getCellByPosition (1, i)
Cell3 = Sheet. getCellByPosition (2, i)
Cell4 = Sheet. getCellByPosition (2, i-1)
IF Cell1.string = "" AND Cell2.string = "" AND Cell3.string <> "" AND Cell4.string <> "" Then
oRows = Sheet.getRows()
oRows.insertByIndex(i,1)
End If
next i
End Sub
Function GetLastRow
oSheet = ThisComponent.getSheets().getByIndex(0) 'číslo listu 0 = první list
oTargetCell = oSheet.getCellByPosition(2, 0) 'start ve 3. sloupci (C)
If IsNull(oTargetCell) then
GetLastRow =oTargetCell.getRangeAddress.EndRow
Else
oCursor = oSheet.createCursorByRange(oTargetCell)
oCursor.gotoEnd
GetLastRow = oCursor.getRangeAddress.EndRow
End if
End Function
A. - Název tak jak je nyní dán ve sloupci C je bez problému pokud je význačný tím, že ostatní buňky ve sloupcích A a B něco mají. Název v buňkách sloupců A,B nic nemá a sám je v buňkách sloupce C. Pokud to tak zůstane, je detekce názvu snadná.
B. - Testování konce je z jiného důvodu celkem velice potřebné. Představte si, že máte 100 řádků a máte přidat za každé 4 řádky jeden další. Znamená to, že na začátku je sto řádků a na konci 125. Když postavíme špatně makro se startem na prvním řádku a koncem cyklu 100 tak na konec nedojede. Když dáme dost řádků navíc musíme konec přejet a raději s větší rezervou.
Když se postaví makro opravdu špatně, tak najde jen první případ čtvrtého řádku a vysází 99 prázdných řádků za sebou. Následuje 96 řádků v původní konstalaci. Takže když se objeví chyba v některém z maker které startují od začátku, najde se chyba na konci.
Problém je s chybou, kterou nelze najít dotazem - například kratší název. To se nepozná ani na konci a nelze ani predikovat počet řádků protože ten se mění podle potřeby.
Právě proto je celkem důležité aby byl název (hledaný výraz) dán jinak nežli počtem znaků. Ovšem když zadáte tak jak jste to udělal Vy, řešitel nemá moc na výběr. Faktem je že zde by stačilo testovat zda je buňka ve sloupcích A(x) + B(x) prázdná, ve sloupci C(x) neprázdná a předchozí buňka v C(x-1) neprázdná.
]]>kabi využil v popise nápis C24...a čo som zabudol pripísať, je, že tento nápis znamená typ materiálu, ktorý sa môže meniť, napr.najčastejšie na KVH, potom by stačilo doplniť do makra ešte dalšie možnosti vo vyhľadávaní.
Dakujem Vam všetkým, aj za rýchlosť, akou som odpovede dostal. Vidim že na taketo vzorce by som tak skoro neprišiel, teraz ma ich analýza posunie zase o niečo vpred ako aj editácie makier všeobecne.
Este raz super dik
sansan
]]>Sub Testuj
Dim Doc, Sheet, Cell1, Cell2 As Object
Dim iEnd as long
Doc = ThisComponent
iEnd = GetLastRow
Sheet = Doc.Sheets(0) 'číslo listu 0 = první list
For i = iEnd To 1 Step - 1
Cell1 = Sheet. getCellByPosition (2, i) 'start ve 3. sloupci (C), 1. řádek
Cell2 = Sheet. getCellByPosition (2, i-1)
IF LEN(Cell1.string) >= 10 AND LEN(Cell1.string) < 15 AND Cell2.string <> "" Then
oRows = Sheet.getRows()
oRows.insertByIndex(i,1)
End If
next i
End Sub
Function GetLastRow
oSheet = ThisComponent.getSheets().getByIndex(0) 'číslo listu 0 = první list
oTargetCell = oSheet.getCellByPosition(2, 0) 'start ve 3. sloupci (C)
If IsNull(oTargetCell) then
GetLastRow =oTargetCell.getRangeAddress.EndRow
Else
oCursor = oSheet.createCursorByRange(oTargetCell)
oCursor.gotoEnd
GetLastRow = oCursor.getRangeAddress.EndRow
End if
End Function
Je to postaveno pro první list. Také by šlo daklarovat "ActiveSheet" jak uvádí LADER ale musela by se přepsat i funkce která testuje poslední řádek.
Vtip je v tom, že když se iteruje od konce tak se nemůže stát banální chyba která spočívá v postupném posouvání posledního řádku. Když není nastaveno dost zbytečných řádků tak nemusí makro dojet na skutečný konec. Když přidá programátor dost řádků tak se iteruje dost zbytečných operací navíc.
V tomto případě je tedy úplně jedno kolik řádků je v sešitě a vždy to dopadne dobře. Samozřejmě předpokladem je že testujeme ve sloupci C a v prvním listu. To se dá ale snadno přepsat. Ještě malé upozornění - makro musí být v aktivním sešitě. takže ne abysto to vložil do MojeMakraStandard nad všemi dokumenty (muselo by se to předeklarovat).
Option VBASupport 1
Sub Vloz_Prazdny_Radek
Dim pocetradku, i
pocetradku = ActiveSheet.Range("C1").currentregion.rows.count 'zjistí počet souvislých řádků ve sloupci C
for i = 2 to pocetradku '2 - pokud chcete mezeru i před první popis, jinak lze zada hodnotu 3
if LEFT(RANGE("C" & i).Value,3) = "C24" then 'řadek s popisem podle prvních 3 znaků ve sloupci C
Range("A" & i).Activate
Selection.EntireRow.Insert
i = i + 1
pocetradku = pocetradku + 1
end if
next
End Sub
Sub Oddelit
Dim oDoc As Object
Dim oSheet As Object
Dim Sloupec,Radek,X,Prazdno
oDoc = ThisComponent
oSheet = oDoc.getCurrentController().ActiveSheet
Prazdno = 0
For Radek = 2 To 999 ' Maximální počet řádků, které se budou kontrolovat
X = ""
For Sloupec = 0 To 3 ' Prohlížíme pouze sloupce 0 až 3
X = X & oSheet.getCellByPosition(Sloupec,Radek).string
Next
Select Case Len(X)
Case 0 ' Prázdný řádek
Prazdno = Prazdno + 1
If Prazdno > 1 Then 'Ukončení hledání
Exit For
End If
Case <15 'Nadpis - odlišení od ostatních řádků, před něj se vloží prázdný řádek
If Prazdno = 0 Then
oSheet.Rows.insertByIndex(Radek,1)
Radek = Radek + 2
Prazdno = 1
End If
Case Else
Prazdno = 0
End Select
Next
End Sub
C24, 60 x 200
C1246 1x krokva 1815
C1249 3x trám 2874
C24, 95 x 45
C1242 1x krokva 2874
C1243 1x krokva 234
C1252 2x krokva 426
C1254 2x krokva 1930
C24, 60 x 240
C1095 1x priečka 1815
C1098 1x priečka 1815
Treba vlozit prázdny riadok.
Koli prehladnosti je poziadavka, nad každý nápis oddeľovací riadok C24,... s rozmerom použitého hranola,a je v riadku samostatne (nachádza sa v 3-tom stĺpci).
Skusim definovať, o čo by sa asi dalo opierat pri programovani makra
-Vyhľadať riadok s C24,(pridal som do pomocného stlpca vzorec =LENB(CONCATENATE(A2;B2;C2;D2)), ktorý mi vypočíta dĺžku textového retazca, a podľa tejto dĺžky program ľahko rozozná že pri výsledku 10 až 14 sa treba pristaviť, a pridať riadok. A pri výsledku rovná sa 15 a viac, sa nebude diať nič. Navyše, je potom treba aby sa na konci tabulky makro zastavilo, teda pri výsledku 0.
Tabulka na konci bude vyzerat takto:
C24, 60 x 200
C1246 1x krokva 1815
C1249 3x trám 2874
C24, 95 x 45
C1242 1x krokva 2874
C1243 1x krokva 234
C1252 2x krokva 426
C1254 2x krokva 1930
C24, 60 x 240
C1095 1x priečka 1815
C1098 1x priečka 1815