Strona 1 z 1

Zmiana wartości komórki

PostNapisane: Cz lis 26, 2015 1:44 pm
przez 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

PostNapisane: Cz lis 26, 2015 2:15 pm
przez 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

PostNapisane: Cz lis 26, 2015 2:54 pm
przez 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

PostNapisane: Pn lis 30, 2015 9:13 pm
przez belstar
Może tak.

Re: Zmiana wartości komórki

PostNapisane: Wt gru 01, 2015 9:12 am
przez 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

PostNapisane: Śr gru 02, 2015 8:26 pm
przez belstar
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.

Re: Zmiana wartości komórki

PostNapisane: Cz gru 03, 2015 10:42 am
przez 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   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