Strona 1 z 1
Zmiana wartości komórki
: czw lis 26, 2015 1:44 pm
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?
Re: Zmiana wartości komórki
: czw lis 26, 2015 2:15 pm
autor: belstar
Makro w twoim przypadku to przesada, funkcje wyszukujące powinny wystarczyć. No chyba że nie opisałeś problemu dokładnie.
Re: Zmiana wartości komórki
: czw lis 26, 2015 2:54 pm
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.
Re: Zmiana wartości komórki
: pn lis 30, 2015 9:13 pm
autor: belstar
Może tak.
Re: Zmiana wartości komórki
: wt gru 01, 2015 9:12 am
autor: tomasss87
Super działa
A można zmienić żeby nie wstawiało tylko wartości cyfrowych ale tez litery?
Re: Zmiana wartości komórki
: śr gru 02, 2015 8:26 pm
autor: belstar
Zmień w linijce:
Kod: Zaznacz cały
oSheet.GetCellbyPosition(1, nCurRow + 1).Value
na
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.
Re: Zmiana wartości komórki
: czw gru 03, 2015 10:42 am
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