Zmiana wartości komórki

[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?

[belstar]

Makro w twoim przypadku to przesada, funkcje wyszukujące powinny wystarczyć. No chyba że nie opisałeś problemu dokładnie.

[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.

[belstar]

Może tak.

[tomasss87]

Super działa

A można zmienić żeby nie wstawiało tylko wartości cyfrowych ale tez litery?

[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.

[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