Escola Saberexcel VBA Estudos® - O site de quem precisa Aprender tudo sobre Macros Microsoft Excel VBA

Esse macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), adiciona 'Soma' um determinado valor digitado à um valor já existente(Antigo) em determinada célula na folha de planilha, com auxilio de um objeto Entrada de Dados (InputBox). isto é, ao digitar um novo valor no Objeto Entrada de Dados 'InputBox', esse valor será automaticamente adicionado, somando ao valor antigo da célula.
Porém fiz um retorno dos dados para a folha de planilha para prática com VBA(Visual Basic Application),
Espero que o exemplo possam lhe ser útil.
Fique com Deus,
Expedito Marcondes.
' - - - - - - - - - - - - - - -
'Essa macro foi retirada da
Coleção 15.000 Macros Microsoft Excel VBA Fórmulas e Funções 'Saberexcel
'- - - - - - - - - - - - - - - - - -
Sub sbx_somar_valores_inptubox_a1()
Dim vNovo As Currency
Dim vAntigo As Currency
Dim vAdicionarValor As Currency
Dim Mensagem, Titulo, Padrao

Mensagem = "Digite o novo valor!"
Titulo = "InputBox somar valores - "
x = "Escola Saberexcel VBA Estudos®"
Y = "Treinamento com Macros, Fórmulas e Funções"
Padrao = "0"
Z = "'- - -' Aprenda MS Excel VBA - SaberExcel ' - - -'"

On Error GoTo errosbx
'observe que usei atribuição variavel CCur() 'moeda' para aceitar somar a parte decimal ao digitar na inputbox
vAdicionarValor = CCur(InputBox(Mensagem & vbCrLf & x & vbCrLf & Y & vbCrLf & Z, Titulo & x, Padrao, 1))
vAntigo = Range("d4").Value
vNovo = vAntigo + vAdicionarValor
Range("d4").Value = vNovo
Saber1.Range("L65000").End(xlUp).Offset(1, 0).Value = vAdicionarValor
Saber1.Range("L65000").End(xlUp).Offset(0, 2).Value = vNovo
Saber1.Range("L65000").End(xlUp).Offset(0, 4).Value = Now()
Saber1.Range("L65000").End(xlUp).Offset(0, 6).Value = Application.UserName

Exit Sub
errosbx: Exit Sub ':MsgBox ("cancelado")
End Sub

Sub sbx_limpar_dados_teste()
Dim resposta As String
resposta = MsgBox("deseja deletar os dados já inseridos", vbYesNo + vbCritical, "Escola Saberexcel VBA Estudos®")
If resposta = 6 Then
[dados].ClearContents
End If
[I1].Select
End Sub

'Format(TotalArea, "0.00")
Sub sbx_teste_sbx_y()
Dim i As Integer, x As Variant
x = Application.InputBox("Entre com número", Type:=1)
If TypeName(x) = "Boolean" Then Exit Sub
i = CInt(x)
MsgBox i
End Sub


Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.

Saberexcel - o site de quem precisa aprender Macros Microsoft Excel VBA

Esse procedimento do Aplicativo Microsoft Excel VBA(visual Basic Application), insere uma soma automaticamente ao digitar na coluna(B),
observe que também que ao deletar um determinado número na colund(D) o valor é automaticamente atualizado, devido o uso da propriedade cells.
Espero que o exemplo possa lhe ser útil. Fique com Deus, Expedito Marcondes.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vTotal As Double
Dim vUltimaLinha As Long
'tres maneiras de localizar a última linha
vUltimaLinha = Cells(Cells.Rows.Count, "D").Row
'vUltimaLinha = Cells(Rows.Count, "D").Row
'vUltimaLinha = Plan1.Range("A65000").End(xlUp).Row 'esse linha de código não atualiza a deleção de dados.(subtrair o que foi deletado)

If Not Application.Intersect(Range("D1:D" & vUltimaLinha), Target) Is Nothing Then
vTotal = Application.WorksheetFunction.Sum(Range("D1:D" & vUltimaLinha))
[F3].Value = vTotal
End If
End Sub



Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.





 

Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções

Este Macro e Procedimentos do Aplicativo Microsoft Excel VBA(Visual Basic Application), realiza uma soma automaticamente ao digitar na coluna(b),
retorna a soma na celula(c2). usando o evento Worksheet_Change 'ao escrever, alterar' celulas em area especifica.

Private Sub Worksheet_Change(ByVal Target As Range)
x = Range("c" & Rows.Count).End(xlUp).Row
If Not Intersect(Range("C2:C" & x), Target) Is Nothing Then
sbx_somar_valores
End If
End Sub
'
Sub sbx_somar_valores()
Dim i As Integer
For i = 2 To Cells(Rows.Count, "c").End(xlUp).Row + 1
tSoma = tSoma + Cells(i, "c").Value
Next i
[e2].Value = tSoma
End Sub

Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos
Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.

Saberexcel - o site das macros
Esse procedimento do Aplicativo Microsoft Excel VBA, usando o evento change(ao digitar) soma (acumula) valores em determinada célula.
Observe que ao digitar na célula (D10) o range.propriedade offset, desloca duas colunas à direita e soma o valor, isto é acumulando o valor digitado,
Espero que lhe possa ser útil. Fique com Deus, Boa Sorte. E_Marcondes


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim vRange As Range

If Target.Cells.Count > 4 Then Exit Sub

Set vRange = Range("D10")

If Not Intersect(Target, vRange) Is Nothing Then
If IsNumeric(Target) And IsNumeric(Target.Offset(0, 2)) Then
Target.Offset(0, 2) = Target + Target.Offset(0, 2) 'pulando uma coluna e inserindo a soma
End If
End If
Set vRange = Nothing
End Sub



Aprenda tudo sobre o Aplicativo Microsoft Excel VBA com Saberexcel

Saberexcel - site das Macros
Essa macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), insere uma soma na coluna(B) referente aos números digitados na coluna(a)
observe que usamos uma Função para os calculos.
Poderá notar que a macro insere fórmulas envolvendo a função Calculo, depois deleta as fórmulas preservando os valores.

Sub insere_formula_funcao_calculo()
[B2].Select
With Range("B1:B" & Range("A65536").End(xlUp).Row)
'definindo a fórmulas
.Formula = "=Calculo(R1C1:R[1]C1)"
.Value = .Value 'deleta fórmulas e preserva valores, faça o teste, comente essa linha e execute a macro para visualizar as fórmulas.
End With
End Sub

Function Calculo(vRegiao As Range) As Double
Dim vCelula As Range
Application.Volatile

For Each vCelula In vRegiao
Calculo = Calculo + vCelula
Next vCelula

End Function

Sub limpar_teste()
[rst].ClearContents
End Sub

Function Calculo(vRegiao As Range) As Double
Dim vCelula As Range
Application.Volatile

For Each vCelula In vRegiao
Calculo = Calculo + vCelula
Next vCelula

End Function

Sub limpar_teste()
[rst].ClearContents
End Sub



Aprenda tudo sobre o Aplicativo Microsoft Excel VBA, sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel