Pergunte aqui
1

Atingir Meta (Macro)

perguntadas 2017-06-27 19:39:06 +0100

updated 2017-06-27 21:14:33 +0100

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 ...
(mais)
editar alterar tag assinalar como ofensivo fechar mesclar Excluir

Comentários

Poste o código completo......

imagem do gravatar de Gilberto SchiavinattoGilberto Schiavinatto ( 2017-06-27 19:51:37 +0100 )editar

Editei acima...

imagem do gravatar de BrunoBMSBrunoBMS ( 2017-06-27 19:57:23 +0100 )editar

2 Respostas

1

respondidas 2017-06-28 00:17:20 +0100

imagem do gravatar de Olivier

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
editar assinalar como ofensivo Excluir Link mais

Comentários

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

imagem do gravatar de BrunoBMSBrunoBMS ( 2017-06-28 13:24:23 +0100 )editar
0

respondidas 2017-06-29 19:52:19 +0100

imagem do gravatar de Grafeno

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,

editar assinalar como ofensivo Excluir Link mais
Login/Registrar para responder

Ferramentas de perguntas

1 seguidor

Estatísticas

Perguntadas: 2017-06-27 19:39:06 +0100

Lidas: 66 vezes

Última atualização: Jun 29