Zmiana wartości komórki

Makropolecenia i funkcje w języku Basic

Zmiana wartości komórki

Postprzez tomasss87 » Cz lis 26, 2015 1:44 pm

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
tomasss87
 
Posty: 5
Dołączył(a): Cz lis 26, 2015 1:31 pm

Re: Zmiana wartości komórki

Postprzez belstar » Cz lis 26, 2015 2:15 pm

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
belstar
 
Posty: 646
Dołączył(a): Cz mar 17, 2011 9:08 am

Re: Zmiana wartości komórki

Postprzez tomasss87 » Cz lis 26, 2015 2:54 pm

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
tomasss87
 
Posty: 5
Dołączył(a): Cz lis 26, 2015 1:31 pm

Re: Zmiana wartości komórki

Postprzez belstar » Pn lis 30, 2015 9:13 pm

Może tak.
Załączniki
Znajdz_Zmien.ods
(14.97 KiB) Pobrane 134 razy
LibreOffice 5.1.2.2 Ubuntu 16 LTS
belstar
 
Posty: 646
Dołączył(a): Cz mar 17, 2011 9:08 am

Re: Zmiana wartości komórki

Postprzez tomasss87 » Wt gru 01, 2015 9:12 am

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
tomasss87
 
Posty: 5
Dołączył(a): Cz lis 26, 2015 1:31 pm

Re: Zmiana wartości komórki

Postprzez belstar » Śr gru 02, 2015 8:26 pm

Zmień w linijce:
Kod: Zaznacz cały   Rozszerz widokZwiń widok
oSheet.GetCellbyPosition(1, nCurRow + 1).Value


Kod: Zaznacz cały   Rozszerz widokZwiń widok
Value
na
Kod: Zaznacz cały   Rozszerz widokZwiń widok
String


Kod: Zaznacz cały   Rozszerz widokZwiń widok
sZmien = Doc.Sheets.getByName("Frazy_Z_Na").GetCellbyPosition(1 , i).getString

na
Kod: Zaznacz cały   Rozszerz widokZwiń widok
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
belstar
 
Posty: 646
Dołączył(a): Cz mar 17, 2011 9:08 am

Re: Zmiana wartości komórki

Postprzez tomasss87 » Cz gru 03, 2015 10:42 am

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   Rozszerz widokZwiń widok
'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   Rozszerz widokZwiń widok
'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
tomasss87
 
Posty: 5
Dołączył(a): Cz lis 26, 2015 1:31 pm


Powrót do Basic

Kto przegląda forum

Użytkownicy przeglądający ten dział: Brak zidentyfikowanych użytkowników i 2 gości