Criar um histórico de contagens por item

Português do Brasil
, , ,
#21

@Joao1, se na planilha Contagem a coluna M der 0 (zero) é lançada ou desprezada na planilha Acompanhamento.

#22

@Joao1, desculpa a ausência…estou em fechamento semanal de indicadores da fábrica.

#23

Ola @Joao1, segue uma macro “funcionando sem parar”… precisa de um conserto…

para parar pressione Shift+F5

NÃO SALVAR EM EXCEL, VAI PERDER AS MACROS.

Arquivo teste 

REM  *****  BASIC  *****

Sub Atualizar
	IrPara "Iniciar" 'Iniciar é a célula E7 nomeada.
	Execute "GoDown"
	Continue
End Sub	

Sub Continue
Dim oSel as Object : oSel = ThisComponent.getCurrentSelection()
Var1 = oSel.getString()
	Do While Var1 = "" Or Var1 = "-"
		Execute "GoDown"
		oSel = ThisComponent.getCurrentSelection()
		Var1 = oSel.getString()
	Loop
	Mover
End Sub

Sub Mover
	Execute "Copy"
	Execute "GoRight"
	InsertCellRight
	ColarOque "SVD"
	Execute "GoLeft"
	Execute "GoDown"
	Continue
End Sub

'0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
'                                                                     SUBMACROS
'0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000

Sub Execute ( oQue$ )
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:" & oQue & "", "", 0, Array())
End Sub

Sub IrPara ( X As String )
'O############################################################################O
dim args1(0) as new com.sun.star.beans.PropertyValue : args1(0).Name = "ToPoint" : args1(0).Value = X
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:GoToCell", "", 0, args1())
End Sub

Sub InsertCellRight
'O############################################################################O
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "Flags" : args1(0).Value = ">"
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:InsertCell", "", 0, args1())
End Sub

Sub ColarOque ( xxx$ )
'O############################################################################O
' Add the letters in the sequence below - |- - - or - -- - - - |
' "S" "V" "D" "F" "N" "T" | “A” |
' Text Number DateTime Formula Annotation Format | All + Object |
'------------------------------------------------------------------------------------|
dim args1(5) as new com.sun.star.beans.PropertyValue
args1(0).Name = "Flags" : args1(0).Value = xxx 
args1(1).Name = "FormulaCommand" : args1(1).Value = 0
args1(2).Name = "SkipEmptyCells" : args1(2).Value = false
args1(3).Name = "Transpose" : args1(3).Value = "false"
args1(4).Name = "AsLink" : args1(4).Value = "false"
args1(5).Name = "MoveMode" : args1(5).Value = 4
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:InsertContents", "", 0, args1())
End Sub

ATENÇÂO:: Para dar mais detalhes a sua pergunta, use Descrição da imagem na pergunta ou Descrição da imagem abaixo. Não use Adicionar resposta para comentário. Grato.

Caso a resposta atendeu sua necessidade, por gentileza, click na bolinha Descrição da imagem a esquerda da resposta, para finalizar a pergunta.

#24

@Joao1, segue complemento verificando qual coluna está vazia para receber a contagem

Sub ChecarProduto
	
	Dim oDoc, oPlan1, oPlan2 as Object
	Dim UltimaLinhaContagem, UltimaLinhaAcompanhamento as Long
	Dim CodigoContagem, CodigoAcompanhamento as String
	Dim Contagem as Double
	Dim LinInicialContagem, LinInicialAcompanhamento as Long
	Dim FaltaCodigo, CodigoOk as String
	Dim nCount, c as Long
	Dim Check as String
	
		oDoc = ThisComponent
		oPlan1 = oDoc.Sheets.getbyname("Contagem")
		oPlan2 = oDoc.Sheets.getbyname("Acompanhamento")
		rng = oPlan2.getcellrangebyname("A8:Z8")
			
			rem as linhas no libreoffice começam a contar a partir do 0. A1  = 0 / A2 = 1 / A3 = 2 .... Serve o mesmo para coluna
			LinInicialContagem = 7
			LinInicialAcompanhamento = 7
			
			rem verifica qual coluna está vazia entre as colunas "E" e "Z"
			For c = 4 to 25
				Check = oPlan2.getcellbyposition(c, LinInicialAcompanhamento).String
				If Check = "" Then
					nCount = c
					Exit for
				End If
			Next c
			
			If nCount = "" then
				MsgBox "Planilha atingiu número máxima de contagens." & Chr(10) & "Crie nova planilha"
				Exit Sub
			End If
			
			Do rem percorre linha a linha da aba Contagem
				CodigoContagem = oPlan1.getcellbyposition (0, LinInicialContagem). String
				Contagem = oPlan1.getcellbyposition (12, LinInicialContagem). Value
				
				rem percorre linha a linha da aba Acompanhamento
				Do While oPlan2.getcellbyposition (0, LinInicialAcompanhamento). String <> ""
					CodigoAcompanhamento = oPlan2.getcellbyposition (0, LinInicialAcompanhamento). String
					If CodigoAcompanhamento = CodigoContagem Then
						oPlan2.getcellbyposition (c, LinInicialAcompanhamento).Value = Contagem
						LinInicialAcompanhamento = 7
						CodigoOk = "Sim"
						FaltaCodigo = ""
						Exit do
					Else
						CodigoOk = "Não"
					End If
					LinInicialAcompanhamento = LinInicialAcompanhamento + 1
				Loop
				
				If CodigoOk = "Não" Then
					FaltaCodigo = CodigoContagem & Chr(10) & FaltaCodigo
				End If
				
				LinInicialContagem = LinInicialContagem + 1
			Loop Until CodigoContagem = ""
			
				If FaltaCodigo <> "" Then
					MsgBox "Códigos não encontrados" & Chr(10) & FaltaCodigo
				End If
			
			MsgBox "Concluido!!"
	
End Sub

@Joao1, segue uma macro para percorrer cada linha da aba contagem, e depois cada linha da aba acompanhamento.

Como funciona:

1 - inicia pegando o código do primeiro produto da aba contagem (linha 08), e depois verifica em cada linhada aba acompanhamento (a partir da linha 08) se contém o código.

2 - quando o código existe, ele pega o valor da contagem (coluna M da aba contagem), e lança na coluna E da aba acompanhamento.

3 - quando algum código da aba contagem, não existir na aba acompanhamento, aparece uma msg no final informando os mesmos.

4 - após concluído toda a programação, aparece uma msg no fim como Concluído.

Sub ChecarProduto
	
	Dim oDoc, oPlan1, oPlan2 as Object
	Dim UltimaLinhaContagem, UltimaLinhaAcompanhamento as Long
	Dim CodigoContagem, CodigoAcompanhamento as String
	Dim Contagem as Double
	Dim LinInicialContagem, LinInicialAcompanhamento as Long
	Dim FaltaCodigo, CodigoOk as String
	
		oDoc = ThisComponent
		oPlan1 = oDoc.Sheets.getbyname("Contagem")
		oPlan2 = oDoc.Sheets.getbyname("Acompanhamento")
			
			rem as linhas no libreoffice começam a contar a partir do 0. A1  = 0 / A2 = 1 / A3 = 2 .... Serve o mesmo para coluna
			LinInicialContagem = 7
			LinInicialAcompanhamento = 7
			
			Do rem percorre linha a linha da aba Contagem
				CodigoContagem = oPlan1.getcellbyposition (0, LinInicialContagem). String
				Contagem = oPlan1.getcellbyposition (12, LinInicialContagem). Value
				
				rem percorre linha a linha da aba Acompanhamento
				Do While oPlan2.getcellbyposition (0, LinInicialAcompanhamento). String <> ""
					CodigoAcompanhamento = oPlan2.getcellbyposition (0, LinInicialAcompanhamento). String
					If CodigoAcompanhamento = CodigoContagem Then
						oPlan2.getcellbyposition (4, LinInicialAcompanhamento).Value = Contagem
						LinInicialAcompanhamento = 7
						CodigoOk = "Sim"
						FaltaCodigo = ""
						Exit do
					Else
						CodigoOk = "Não"
					End If
					LinInicialAcompanhamento = LinInicialAcompanhamento + 1
				Loop
				
				If CodigoOk = "Não" Then
					FaltaCodigo = CodigoContagem & Chr(10) & FaltaCodigo
				End If
				
				LinInicialContagem = LinInicialContagem + 1
			Loop Until CodigoContagem = ""
			
				If FaltaCodigo <> "" Then
					MsgBox "Códigos não encontrados" & Chr(10) & FaltaCodigo
				End If
			
			MsgBox "Concluido!!"
	
End Sub
#25

@Conras Era quase isso amigo, infelizmente só está registrando a contagem atual no lugar da última contagem, não havendo a movimentação de um “Histórico”

@schiavinatto Era isso mesmo. Exatamente o que eu precisava. Como imaginei ficou bastante extenso. Estava trabalhando e elaborei em cima da base de VBA e consegui elaborar exatamente do jeito que eu queria. Todavia, ele não funciona no Office pelo fato das particularidades do Excel. Há como traduzir esse macro para rodar no Office?
Não conheço muito afundo sobre as funções do Office.

Desde já agradeço aos dois pela iniciativa e pela ajuda!
Muito obrigado,
Bom trabalho!

#26

Ola @Joao1, creio que pediu ajuda no lugar errado, aqui é para LibreOffice. Eu não utilizo MS desde 1998 quando conheci o StarOffice, fico devendo.

#27

@Joao1, fiz com base informado que seria uma planilha por data, ajustando a macro dá para colocar em coluna seguintes.

Conforme informado pelo @schiavinatto, não tem como você utilizar a programação do LibreOffice e salvar a planilha em extensão xls, pois a macro seria apagada.

Em relação a compatibilidade MsOffice e LibreOffice, algumas funções não existe no LibreOffice, mas tem como adaptar praticamente tudo que se escreve em MsOffice.

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