Atingir Meta (Macro)

Português do Brasil
, ,
#1

Bom dia.

Estou tentando trabalhar com uma macro para atingir meta em diversas abas.
Há uma macro que eu importei do VBA de um arquivo do excel que eu fiz.
Porém, não está operacional com o LibreOffice.

Abaixo uma prévia do código:

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub MetaGeral()
    metaNova = Plan1.Cells(3, 10).Value
    Sheets("RESUMO").Select
    Range("A1").Select
    Sheets("IN-01").Select
    If Range("C30").Value <> 0 Then
        Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
    End If

Sheets("IN-02").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-03").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-04").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-05").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-06").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-07").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-08").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-09").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-10").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-11").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-12").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-13").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-14").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-15").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("IN-16").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If
Sheets("PN-01").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-02").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-03").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-04").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-05").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-06").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-07").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-08").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-09").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-10").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-11").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-12").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-13").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-14").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-15").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-16").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-17").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-18").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-19").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("PN-20").Select
If Range("D30").Value <> 0 Then
    Range("E30").GoalSeek Goal:=metaNova, ChangingCell:=Range("D4")
End If

Sheets("ST-UP").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("PROG").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("SUPERV").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If

Sheets("MO").Select
If Range("C30").Value <> 0 Then
    Range("D30").GoalSeek Goal:=metaNova, ChangingCell:=Range("C9")
End If
Sheets("RESUMO").Select
Range("A1").Select

End Sub

São várias abas, essa fórmula é executada em todas elas.
Porém, a minha dúvida é realmente nesta sintaxe…

#2

Poste o código completo…

#3

Editei acima…

#4

Tenho este código que calcula o Atingir meta na planilha1, célula de formula em D15, célula variável em D8, valor a atingir = “0” (targetresult).

Sub GS
dim cell as object
dim resultfound as new  com.sun.star.sheet.GoalResult '(divergence,result structure)
dim formula_address as new  com.sun.star.table.CellAddress  '(sheet,column, Row structure)
dim variable_address as new  com.sun.star.table.CellAddress
dim targetresult as string  'goal value sought as STRING

oDoc=thiscomponent
sheet = oDoc.Sheets(0)

'set location of formula to be evaluated to give goal value
formula_address.sheet = 0  'index values - zero based
formula_address.Row=14
variable_address.sheet = 0
variable_address.Row=7

cell = Sheet.getCellByPosition(3,7)
formula_address.Column = 3

' set location of variable to be changed

variable_address.Column = 3

' set goal value
targetresult = "0"
' run goalseek
resultfound = oDoc.seekgoal(formula_address,variable_address,targetresult)
' do something with result
rem msgbox resultfound.result
cell.Value=resultfound.result

end sub
#5

Bom dia

Beleza, obrigado. Vou testar…
Como vou fazer em várias abas, acho que posso usar o comando para chamar ela após abrir cada aba, certo?
Só vou executar a macro no caso de ter valores naquela aba…

Sheets("IN-02").Select
If Range("C30").Value <> 0 Then
    call MacroRentabilidade
End If

Grato

#6

Boa tarde,


Veja se é isso que você procura: 
Sub DefinirMetas
Dim oDoc, oPlan1, oPlan, oCel
Dim novaMeta as String
   
   oDoc = ThisComponent   
   oPlan1 = oDoc.Sheets(0) '1ª planilha (a que estiver mais a esquerda)'
   novaMeta = oPlan1.getCellByPosition(9,2).String 'Linha 10, coluna 3 porque'
                                                   'o índice começa com 0'
   
   For i = 1 to 16
      oPlan = oDoc.Sheets.GetByName("IN-" & Right("0"&i,2))
      oCel = oPlan.getCellRangeByName("C30")
      If oCel.Value <> 0 Then
         'msgbox oPlan.Name'
         Call MetaRentabilidade(oPlan,"D30","C9",novaMeta)
      End If
   Next i
   
   For j = 1 to 6
      oPlan = oDoc.Sheets.GetByName("PN-" & Right("0"&j,2))
      oCel = oPlan.getCellRangeByName("D30")
      If oCel.Value <> 0 Then
         'msgbox oPlan.Name'
         Call MetaRentabilidade(oPlan,"E30","D4",novaMeta)        
      End If
   Next j
End Sub


Sub MetaRentabilidade(oPlanilha, sCelFor, sCelVar, sMeta)
Dim oDoc, oCF, oCV, oMeta
   oDoc = ThisComponent
   oCF = oPlanilha.getCellRangeByName(sCelFor)
   oCV = oPlanilha.getCellRangeByName(sCelVar)
   oMeta = oDoc.seekGoal(oCF.CellAddress,oCV.CellAddress,sMeta)
   oCV.Value = oMeta.Result
End Sub

Atte,

Impressum (Legal Info) | Datenschutzerklärung (Privacy Policy)   Content on this site is licensed under a Creative Commons Attribution Share Alike 3.0 license.