Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

barevnej · 7. 6. 2023 11:26:00

Snažím se vytvořit makro které by mě posunulo na konec dat alá Ctrl+End. Jenže potřebuji to jen v jednom sloupci a ne ve všem jako je u Ctrl+End. Ostatní sloupce jsou třeba delší atd...
Jinak data ve sloupci A může mít i mezery jako že je vyplněná 1 až 100 pak 101 je prádná řádek a pak od 102 zase pokračuje. Tj musí skočit až na poslední opravdu prázdný tak jako Ctrl+End.

Zkoušel jsem něco jako...

Sub SkocNaPosledniNeprazdnou()
    Dim sheet As Object
    Dim lastRow As Long
    sheet = ThisComponent.Sheets(0)
    lastRow = sheet.getCellRangeByName("A" & sheet.Rows.Count).EndOfUsedArea.Row
    sheet.setActiveCell(sheet.getCellByPosition(0, lastRow))
End Sub

Což nefunguje.
https://uloz.to/file/ICgwOf60cm43/test- … IEGGpjMt==

Editoval barevnej (8. 6. 2023 15:50:38)

LADER · 7. 6. 2023 12:11:24

Control+G nevyhovuje?
Nebo Control+[šipka dolů]

Editoval LADER (7. 6. 2023 12:23:18)

barevnej · 7. 6. 2023 12:33:53

Tyto zkratky mi v Ubuntu nefungují. Ale i tak potřebuji to makrem abych si vytvořil tlačítko, z důvodu ovládání na dálku přes mobil kde nemám k dispozici klávesnici.

LADER · 7. 6. 2023 12:45:19

Asi takhle?

Sub Main
	dim document   as object
	dim dispatcher as Object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	
	' Na poslední vyplněnou ve sloupci
	dim args1(1) as new com.sun.star.beans.PropertyValue
	args1(0).Name = "By"
	args1(0).Value = 1
	args1(1).Name = "Sel"
	args1(1).Value = false
	
	dispatcher.executeDispatch(document, ".uno:GoDownToEndOfData", "", 0, args1())

	' O jednu dolů
	dim args2(1) as new com.sun.star.beans.PropertyValue
	args2(0).Name = "By"
	args2(0).Value = 1
	args2(1).Name = "Sel"
	args2(1).Value = false
	
	dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args2())
End Sub

barevnej · 7. 6. 2023 13:02:56

Je to téměř dokonalé, ještě kdyby to umělo přeskočit případnou mezeru které je vždy jen jedna mezi daty.

barevnej · 7. 6. 2023 13:37:39

Tak upravil jsem trochu jinak

Sub Main
   Dim document As Object
   Dim dispatcher As Object
   Dim emptyCellCount as Integer
   Const MAX_EMPTY_CELLS = 2
   
   document = ThisComponent.CurrentController.Frame
   dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

   ' Na poslední vyplněnou ve sloupci
   Dim args1(1) As New com.sun.star.beans.PropertyValue
   args1(0).Name = "By"
   args1(0).Value = 1
   args1(1).Name = "Sel"
   args1(1).Value = False

   dispatcher.executeDispatch(document, ".uno:GoDownToEndOfData", "", 0, args1())

   ' O jednu dolů
   Dim args2(1) As New com.sun.star.beans.PropertyValue
   args2(0).Name = "By"
   args2(0).Value = 1
   args2(1).Name = "Sel"
   args2(1).Value = False

   Do While emptyCellCount < MAX_EMPTY_CELLS
       ' Kontrola, zda je buňka prázdná
       If Len(ThisComponent.CurrentSelection.getString()) = 0 Then
           emptyCellCount = emptyCellCount + 1
       Else
           emptyCellCount = 0
       End If
       
       ' Pokud jsou dvě prázdné buňky za sebou, skonči cyklus
       If emptyCellCount >= MAX_EMPTY_CELLS Then
           Exit Do
       End If

       ' Posun na další buňku
       dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args2())
   Loop
End Sub

Nicméně se zdá že to takto funguje

barevnej · 7. 6. 2023 13:51:11

Jenže to jede před očima buňku po buňce... Což třeba u pár tisíc řádků je dosti zdlouhavé.

LADER · 7. 6. 2023 19:01:54

Sub LastRowInColumn
	Dim oDoc As Object, oSheet As Object, oRange As Object, oColumn As Object, oCell As Object 
	Dim iColumn As Long, lCount As Long, lRow As Long 
 	oDoc	 = ThisComponent
 	oSheet = oDoc.CurrentController.ActiveSheet
 	iColumn = oDoc.CurrentSelection.RangeAddress.StartColumn
 	oColumn = oSheet.Columns.getByIndex(iColumn)
 	oRange = oColumn.queryContentCells(1023)
 	lCount = oRange.getCount()
 	If lCount>0 Then        
 		lRow = oRange.getByIndex(lCount-1).RangeAddress.EndRow+1
 		oCell = oColumn.getCellByPosition(0, lRow)
 		oDoc.CurrentController.select(oCell)
 	EndIf 
End Sub

LADER · 7. 6. 2023 19:34:53

Nebo takto:

Sub GetLastRowInCol
	Dim oDoc As Object, oSheet As Object, oRange As Object, oCol As Object, oCell As Object, oLast As Object  
	oDoc	  = ThisComponent
	oSheet = oDoc.CurrentController.ActiveSheet	
	oCol = oSheet.Columns.getByIndex(oDoc.CurrentSelection.RangeAddress.StartColumn)	
	oLast = oCol.queryEmptyCells()
	oRange = oLast.getByIndex(oLast.getCount()-1)	
	oCell   = oCol.getCellByPosition(0, oRange.RangeAddress.StartRow)
	oDoc.CurrentController.select(oCell)
End Sub

Editoval LADER (7. 6. 2023 19:36:38)

neutr · 8. 6. 2023 07:00:05

Tady jedno mé makro

sub CisPoslRadkuNaSloupci()
Dim oDoc As Object
dim lastRow as Long
dim oSheet as object
Dim oCol,rd,find,aray
oDoc = ThisComponent
oSheet = oDoc.Sheets().getByName("List1")
oCol = oSheet.getColumns().getByIndex(0)
rd = oCol.createReplaceDescriptor
rd.searchRegularExpression = true
rd.setSearchString(".")
find = oCol.FindAll(rd)
aray = Split(find.AbsoluteName,"$")
lastRow = aray(ubound(Aray))
Print lastRow
end sub

Mám také vzorec, který na rozdíl od makra vrátí hodnotu posledního záznamu v "řídkém" sloupci. Například :

=LOOKUP(2,1/NOT(ISBLANK($A2:$A1000000)),$A2:$A1000000)

V prvním sloupci A1 mám buňku s názvem sloupce (nepodstatné) a ve druhém řádku vzorec za kterým jsou porůznu nesouvisle zadané (řídké) hodnoty. Vzorec vrátí hodnotu obsahu poslední buňky.

Oboje můžete testovat na stejném listu a sloupci.

barevnej · 8. 6. 2023 09:14:25

Tak děkuji kluci, otestoval jsem všechno a nejlepší je ta prostřední cesta. Ono to mám spojené s dalším makrem které otevírá vložit nefomátovaný text Shift+Ctrl+Alt+V.
Super teď je že mohu data vkládat pod sebe s Vámi vytvořeným makrem kdy mám ukotvený první řádek s tlačítkem. Makro to vždy vloží pod stávající data. Stačí při vkládání klikat na tlačítko.

sub Vlozit_jako
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$2"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
   Vlozit_jakoNEXT
End Sub

Sub Vlozit_jakoNEXT
	Dim oDoc As Object, oSheet As Object, oRange As Object, oCol As Object, oCell As Object, oLast As Object  
	oDoc	  = ThisComponent
	oSheet = oDoc.CurrentController.ActiveSheet	
	oCol = oSheet.Columns.getByIndex(oDoc.CurrentSelection.RangeAddress.StartColumn)	
	oLast = oCol.queryEmptyCells()
	oRange = oLast.getByIndex(oLast.getCount()-1)	
	oCell   = oCol.getCellByPosition(0, oRange.RangeAddress.StartRow)
	oDoc.CurrentController.select(oCell)
   Vlozit_jakoNEXT2
End Sub

sub Vlozit_jakoNEXT2
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:PasteUnformatted", "", 0, Array())
end sub

Ještě bych měl dotaz který navazuje na to co dělám. Je technicky možné po vyvolání vložit nefomátovaný text Shift+Ctrl+Alt+V rovnou odkliknout ok? Mám tušení že to tak snadno nepůjde, zda jestli vůbec.

Editoval barevnej (8. 6. 2023 10:55:46)

LADER · 8. 6. 2023 13:00:31

Zdravím, tuto funkci co jsem napsal je fakt prasárna, ale funguje to:

Function ZapisNaKonec(lCol As Long, Val As Variant) As Long 
	Dim oSheet As Object, oCol As Object
	Dim oCell As Object, oEmpty As Object, oRg As Object
	Dim lRow As Long 	
	oSheet = ThisComponent.CurrentController.ActiveSheet
	oCol = oSheet.Columns.getByIndex(lCol)
	oEmpty = oCol.queryEmptyCells()
	oRg = oEmpty.getByIndex(oEmpty.getCount()-1)
	lRow = oRg.RangeAddress.StartRow
	' Zapíšeme hodnotu na konec zvoleného sloupce	
	oSheet.getCellByPosition(lCol, lRow).Value = Val 
	' Funkce vrátí číslo posledního řádku
	ZapisNaKonec = lRow
End Function

Má dva parametry číslo sloupce (A je 0, B je 1, atd) a hodnotu. Ta může odkazovat na libovolný místo (třeba A2). Pokud se do tohoto místa zapíše nějaká hodnota a stiskne se Enter, pak funkce vrátí číslo řádku do kterého se provede zápis a skutečně se tam ta hodnota zapíše. Což by nemělo fungovat, ale funguje to.

UPOZORNĚNÍ: Tuto funkci nedoporučuji používat (funkce by neměla zapisovat tam kam nemá), to je jen tak pro zajímavost

Editoval LADER (9. 6. 2023 11:34:58)

LADER · 8. 6. 2023 13:11:10

Tady jsou nějaké moje testy:
Odkaz na soubor
Je tam i jiný způsob podle tlačítek (možná by mohlo být jen jedno ... )

barevnej · 8. 6. 2023 14:28:50

Už tak jak jsi psal minule je to dokonalý, upravil jsem si pro vícero situací, rychlost je blesková bez ohledu množství dat i mezer. Fakt mi to moc pomohlo Děkuji.

ludviktrnka · 9. 6. 2023 14:04:59

Taky přispěju se svou troškou do mlejna :-)

Sub skoc_na_konec
  Dim oSh As Object
  Dim oSloupec as Object
  Dim oOblasti as Object
  Dim oBunka as Object
	
  oSh = ThisComponent.Sheets.GetByName("vstup_z_banky")
  oSloupec = oSh.GetCellRangeByName("G2:G10000")
  oOblasti = oSloupec.queryContentCells(1+2+4+16).RangeAddresses

  If Ubound(oOblasti) < 0 Then   ' Nenalezeno, vybereme začátek
     radek = 2
  Else   
    radek = oOblasti(Ubound(oOblasti)).EndRow + 2
  End If 
  presun ( "G" & radek )
End Sub


sub presun (pozice as string) 'metoda pro ulození poslední hodnoty
	dim dokument   as object
	dim dispatcher as object
	dokument   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	dim args1(0) as new com.sun.star.beans.PropertyValue
	args1(0).Name = "ToPoint"
	args1(0).Value = pozice
	dispatcher.executeDispatch(dokument, ".uno:GoToCell", "", 0, args1())
end sub

Editoval ludviktrnka (9. 6. 2023 14:05:14)

OpenOffice.cz - web věnovaný kancelářským balíkům OpenOffice.org

#1 7. 6. 2023 11:26:00

Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#2 7. 6. 2023 12:11:24

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#3 7. 6. 2023 12:33:53

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#4 7. 6. 2023 12:45:19

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#5 7. 6. 2023 13:02:56

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#6 7. 6. 2023 13:37:39

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#7 7. 6. 2023 13:51:11

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#8 7. 6. 2023 19:01:54

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#9 7. 6. 2023 19:34:53

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#10 8. 6. 2023 07:00:05

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#11 8. 6. 2023 09:14:25

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#12 8. 6. 2023 13:00:31

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#13 8. 6. 2023 13:11:10

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#14 8. 6. 2023 14:28:50

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

#15 9. 6. 2023 14:04:59

Re: Posun na poslední vyplněnou buǩu ve sloupci A (Vyřešeno)

Zápatí