| Descricao: |
 Escola Saberexcel VBA Estudos - Treinamentos com Macros, Fórmulas e Funções
Esses macros do aplicativo Microsoft excel VBA, monta um (suposto) Fluxo de Caixa, Despesas, receitas, lucro líquido, lucro bruto, Cálculo de Impostos, usando as Propriedades Celulas e Range(), acumulando soma em variáveis, deslocando linhas, copiando área com desclocamentos
a com auxilio da Propriedade Cells(linha,Coluna).Resize(linhas, Colunas).
Espero que o exemplo possam ajudá-los. Fiquem com Deus,
Expedito Marcondes.
'com base nos dados solicitados.
'Escola Saberexcel VBA Estudos
Sub sbx_distribuicao()
Dim i, ColDesp, LinDesp, LinLB As Long
Dim tSoma, LucroBruto As Double
'//====' copiar area para calculos 'treinar com a propriedade resize
Saber2.Cells(18, 5).Resize(4, 4).Copy [despesas]
'//====' receita
Cells(6, "c").Value = CDbl(35654.98)
Cells(6, "d").Value = CDbl(43758.75)
Cells(6, "e").Value = CDbl(42544.23)
Cells(6, "f").Value = CDbl(46879.47)
'//====' despesas
For ColDesp = 3 To 6
For LinDesp = 11 To 15
Cells(LinDesp, ColDesp).Select
If Cells(LinDesp, ColDesp).Value <> "" Then
tSoma = tSoma + Cells(LinDesp, ColDesp).Value
Else
Cells(LinDesp + 1, ColDesp).Value = tSoma
Cells(LinDesp - 6, ColDesp).Value = tSoma
tSoma = 0
Exit For
End If
Next LinDesp
Next ColDesp
'//====='Lucro bruto
LinLB = 18
For LucroBruto = 3 To 6
Cells(LinLB, LucroBruto).Value = Cells(LinLB - 12, LucroBruto).Value - Cells(LinLB - 9, LucroBruto)
'//=====' impostos (deslocamentos de Linhas e Colunas) para os calculos
Cells(LinLB + 2, LucroBruto).Value = (Cells(LinLB, LucroBruto).Value * 0.4)
'//=====' lucro liquido
Cells(LinLB + 4, LucroBruto).Value = Cells(LinLB, LucroBruto).Value - Cells(LinLB + 2, LucroBruto).Value
'//=====' porcentagem lucro liquido = receita total
Cells(LinLB + 6, LucroBruto).Value = CDbl(Cells(LinLB + 4, LucroBruto).Value / Cells(LinLB - 12, LucroBruto).Value)
Next LucroBruto
sbx_somar_colunas
[k1].Select
End Sub
Sub sbx_somar_colunas()
Dim vCol As Long
Dim vLin, LinLB As Long
'//======'copiando os valores das despesas da planiha auxiliar
'//======'para a célula renomeada como 'despesas'
Saber2.Cells(18, "E").Resize(4, 4).Copy [despesas] 'redimensionando uma area busca e copia para restaurar dados na tabela original fluxo caixa
[h6:h24].Value = ""
For vLin = 6 To 24
For vCol = 3 To 6
Cells(vLin, vCol).Select
If Cells(vLin, vCol).Value <> "" Then
tSoma = tSoma + Cells(vLin, vCol).Value
End If
Next vCol
Cells(vLin, "h").Value = tSoma
If vLin = 24 Then
Cells(vLin, "h").Value = CDbl(tSoma / 4) ', "##.##" & "%")
End If
tSoma = 0
Next vLin
End Sub
Sub sbx_limpar_teste()
[c6:h24].ClearContents
End Sub
Sub sbx_mostrar_macro_wordPad()
ActiveSheet.Shapes.Range(Array("Saberexcel")).Select
Selection.Verb Verb:=xlPrimary
Range("O13").Select
End Sub
Sub sbx_cores_vb()
Dim i As Long
For i = 1 To 56
Saber3.Cells(i, "a").Interior.ColorIndex = i
Saber3.Cells(i, "b").Value = i
Next i
End Sub
Sub sbx_cores_vb_limpar()
[a1:b60].Clear
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.
|