Zmiana wartości komórki

Makropolecenia i funkcje w języku Basic
tomasss87
Posty: 5
Rejestracja: czw lis 26, 2015 1:31 pm

Zmiana wartości komórki

Post autor: tomasss87 »

Potrzebuje makra działającego na zasadzie if.
Konkretnie:
jeżeli w kolumnie A w którymkolwiek wierszu znajdzie fraze X to żeby do kolumny C wiersza tego samego wstawiło YY
czyli jeżeli w A35 znajdzie wiertarka to żeby w C35 wstawiło 100
może ktoś pomóc?
OpenOffice 4.1.3.2 na Windows 7
belstar
Posty: 654
Rejestracja: czw mar 17, 2011 9:08 am

Re: Zmiana wartości komórki

Post autor: belstar »

Makro w twoim przypadku to przesada, funkcje wyszukujące powinny wystarczyć. No chyba że nie opisałeś problemu dokładnie.
LibreOffice 5.1.2.2 Ubuntu 16 LTS
tomasss87
Posty: 5
Rejestracja: czw lis 26, 2015 1:31 pm

Re: Zmiana wartości komórki

Post autor: tomasss87 »

Problem dotyczy codziennego podmieniania masowych ilości danych zawierających te same informacje, stąd potrzeba makra. Fraz do wyszukania i podmiany danych na chwile obecną mam ponad 50 stąd pomysł na raz zdefiniowane makro.
OpenOffice 4.1.3.2 na Windows 7
belstar
Posty: 654
Rejestracja: czw mar 17, 2011 9:08 am

Re: Zmiana wartości komórki

Post autor: belstar »

Może tak.
Załączniki
Znajdz_Zmien.ods
(14.97 KiB) Pobrany 377 razy
LibreOffice 5.1.2.2 Ubuntu 16 LTS
tomasss87
Posty: 5
Rejestracja: czw lis 26, 2015 1:31 pm

Re: Zmiana wartości komórki

Post autor: tomasss87 »

Super działa :)

A można zmienić żeby nie wstawiało tylko wartości cyfrowych ale tez litery?
OpenOffice 4.1.3.2 na Windows 7
belstar
Posty: 654
Rejestracja: czw mar 17, 2011 9:08 am

Re: Zmiana wartości komórki

Post autor: belstar »

Zmień w linijce:

Kod: Zaznacz cały

oSheet.GetCellbyPosition(1, nCurRow + 1).Value

Kod: Zaznacz cały

Value
na

Kod: Zaznacz cały

String

Kod: Zaznacz cały

sZmien = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(1 , i).getString
na

Kod: Zaznacz cały

sZmien = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(1 , i).getValue
Teraz zawsze będziesz miał wstawiony tekst nawet jeśli zmienna zawiera cyfry.
LibreOffice 5.1.2.2 Ubuntu 16 LTS
tomasss87
Posty: 5
Rejestracja: czw lis 26, 2015 1:31 pm

Re: Zmiana wartości komórki

Post autor: tomasss87 »

Staram się dodać kolejną zmianę dodając kolejnego identycznego suba i funkcję z podmienioną wartością definiującą w której komórce ma się znajdować jednak nie działa, wiesz może dlaczego ?

Kod: Zaznacz cały

'Można się pobawić w optymalizacje ale nie chce mi się.
'Nie ponoszę za szkody powstałe w wyniku błędnego działania.
'Zalecam testowanie i tworzenie kopii zapasowej.
'BELSTAR
Sub Znajdz_Zmien
	Dim Doc As Object
	Dim Zeszyt As Object
	
	Doc = ThisComponent
	Zeszyt = Doc.Sheets.getByName("Baza")
	iFrazy = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(3, 1).getValue
	For i = 1 to iFrazy
		sSzukana = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(0 , i).getString
		sZmien = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(1 , i).getString
		uFind(sSzukana, sZmien, Zeszyt)
	Next
End Sub

'funkcja na podstawie AndrewMacro
Function uFind(sString$, repVal, oSheet) As Variant
	Dim nCurCol As Integer
	Dim nCurRow As Integer
	Dim oCell As Object
	Dim oCursor As Object
	Dim oData
	Dim oRow
	
	oCell = oSheet.GetCellbyPosition(7, 1 )
	oCursor = oSheet.createCursorByRange(oCell)
	oCursor.GotoEndOfUsedArea(True)
	oData = oCursor.getDataArray()
		For nCurRow = LBound(oData) To UBound(oData)
			oRow = oData(nCurRow)
			For nCurCol = LBound(oRow) To UBound(oRow)
				If InStr(oRow(nCurCol),sString$) > 0 Then
					oSheet.GetCellbyPosition(3, nCurRow + 1).Value = repVal 
					
				End If
			Next
		Next
End Function

'Można się pobawić w optymalizacje ale nie chce mi się.
'Nie ponoszę za szkody powstałe w wyniku błędnego działania.
'Zalecam testowanie i tworzenie kopii zapasowej.
'BELSTAR
Sub kody
	Dim Doc As Object
	Dim Zeszyt As Object
	
	Doc = ThisComponent
	Zeszyt = Doc.Sheets.getByName("Baza")
	iFrazy = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(15, 1).getValue
	For i = 1 to iFrazy
		sSzukana = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(11 , i).getString
		sZmien = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(12 , i).getString
		uFinds(sSzukana, sZmien, Zeszyt)
	Next
End Sub

'funkcja na podstawie AndrewMacro
Function uFinds(sString$, repVal, oSheet) As Variant
	Dim nCurCol As Integer
	Dim nCurRow As Integer
	Dim oCell As Object
	Dim oCursor As Object
	Dim oData
	Dim oRow
	
	oCell = oSheet.GetCellbyPosition(7, 1 )
	oCursor = oSheet.createCursorByRange(oCell)
	oCursor.GotoEndOfUsedArea(True)
	oData = oCursor.getDataArray()
		For nCurRow = LBound(oData) To UBound(oData)
			oRow = oData(nCurRow)
			For nCurCol = LBound(oRow) To UBound(oRow)
				If InStr(oRow(nCurCol),sString$) > 0 Then
					oSheet.GetCellbyPosition(5, nCurRow + 1).Value = repVal 
					
				End If
			Next
		Next
End Function

udało mi się poprawić i teraz wygląda to tak:

Kod: Zaznacz cały

'Można się pobawić w optymalizacje ale nie chce mi się.
'Nie ponoszę za szkody powstałe w wyniku błędnego działania.
'Zalecam testowanie i tworzenie kopii zapasowej.
'BELSTAR
Sub Znajdz_Zmien
	Dim Doc As Object
	Dim Zeszyt As Object
	
	Doc = ThisComponent
	Zeszyt = Doc.Sheets.getByName("Baza")
	iFrazy = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(3, 1).getValue
	For i = 1 to iFrazy
		sSzukana = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(0 , i).getString
		sZmien = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(1 , i).getString
		uFind(sSzukana, sZmien, Zeszyt)
	Next
End Sub

'funkcja na podstawie AndrewMacro
Function uFind(sString$, repVal, oSheet) As Variant
	Dim nCurCol As Integer
	Dim nCurRow As Integer
	Dim oCell As Object
	Dim oCursor As Object
	Dim oData
	Dim oRow
	
	oCell = oSheet.GetCellbyPosition(7, 1 )
	oCursor = oSheet.createCursorByRange(oCell)
	oCursor.GotoEndOfUsedArea(True)
	oData = oCursor.getDataArray()
		For nCurRow = LBound(oData) To UBound(oData)
			oRow = oData(nCurRow)
			For nCurCol = LBound(oRow) To UBound(oRow)
				If InStr(oRow(nCurCol),sString$) > 0 Then
					oSheet.GetCellbyPosition(3, nCurRow + 1).Value = repVal 
					
				End If
			Next
		Next
End Function




'Można się pobawić w optymalizacje ale nie chce mi się.
'Nie ponoszę za szkody powstałe w wyniku błędnego działania.
'Zalecam testowanie i tworzenie kopii zapasowej.
'BELSTAR
Sub Kody
	Dim Doc As Object
	Dim Zeszyt As Object
	
	Doc = ThisComponent
	Zeszyt = Doc.Sheets.getByName("Baza")
	iFrazy = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(3, 1).getValue
	For i = 1 to iFrazy
		sSzukana = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(4 , i).getString
		sZmien = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(5 , i).getString
		uFinds(sSzukana, sZmien, Zeszyt)
	Next
End Sub

'funkcja na podstawie AndrewMacro
Function uFinds(sString$, repVal, oSheet) As Variant
	Dim nCurCol As Integer
	Dim nCurRow As Integer
	Dim oCell As Object
	Dim oCursor As Object
	Dim oData
	Dim oRow
	
	oCell = oSheet.GetCellbyPosition(7, 1 )
	oCursor = oSheet.createCursorByRange(oCell)
	oCursor.GotoEndOfUsedArea(True)
	oData = oCursor.getDataArray()
		For nCurRow = LBound(oData) To UBound(oData)
			oRow = oData(nCurRow)
			For nCurCol = LBound(oRow) To UBound(oRow)
				If InStr(oRow(nCurCol),sString$) > 0 Then
					oSheet.GetCellbyPosition(5, nCurRow + 1).String = repVal 
					
				End If
			Next
		Next
End Function

Sub nazwy
	Dim Doc As Object
	Dim Zeszyt As Object
	
	Doc = ThisComponent
	Zeszyt = Doc.Sheets.getByName("Baza")
	iFrazy = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(3, 1).getValue
	For i = 1 to iFrazy
		sSzukana = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(8 , i).getString
		sZmien = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(9 , i).getString
		uFindsaa(sSzukana, sZmien, Zeszyt)
	Next
End Sub

'funkcja na podstawie AndrewMacro
Function uFindsaa(sString$, repVal, oSheet) As Variant
	Dim nCurCol As Integer
	Dim nCurRow As Integer
	Dim oCell As Object
	Dim oCursor As Object
	Dim oData
	Dim oRow
	
	oCell = oSheet.GetCellbyPosition(7, 1 )
	oCursor = oSheet.createCursorByRange(oCell)
	oCursor.GotoEndOfUsedArea(True)
	oData = oCursor.getDataArray()
		For nCurRow = LBound(oData) To UBound(oData)
			oRow = oData(nCurRow)
			For nCurCol = LBound(oRow) To UBound(oRow)
				If InStr(oRow(nCurCol),sString$) > 0 Then
					oSheet.GetCellbyPosition(7, nCurRow + 1).String = repVal 
					
				End If
			Next
		Next
End Function
OpenOffice 4.1.3.2 na Windows 7
ODPOWIEDZ