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

Esse macro do aplicativo Microsoft Excel VBA, usando o objeto Dictionary, gera números aleatórios,
com o objetivo didatico há um incremento no macro para inserir cores aleatórias no interior das células na folha de planilhas
como também gerar cores da fonte da célula aleatórios.
Espero que gostem do exemplo de planilha que poderá baixá-la no final da página.
Fique com Deus, Expedito Marcondes

'//===='Escola Saberexcel VBA Estudos®
''//===='Treinamentos com Macros, Fórmulas e Funções
''''//===='Site: http://www.microsoftexcel.com.br
'''''//===='Email: [email protected]
''''''//===================================='

Sub numeros_aleatorios_grupos()
Dim Dicionario As Object
Range("A:A").Clear
d = 1

For i = 1 To 5
Set Dicionario = CreateObject("Scripting.Dictionary") leia sobre Objeto Dictionary
While Dicionario.Count < 5
Randomize
sbx = Int((1000 * Rnd)) + 1
Dicionario(sbx) = sbx
Wend
Cells(d, 1).Resize(Dicionario.Count) = Application.Transpose(Dicionario.keys)
Cells(d, 1).Resize(Dicionario.Count).Interior.ColorIndex = Int((56 * Rnd)) + 1
Cells(d, 1).Resize(Dicionario.Count).Font.ColorIndex = Int((56 * Rnd)) + 1
Cells(d, 1).Resize(Dicionario.Count).Font.Size = 8 'Int((16 * Rnd)) + 1
d = d + 6
Next i

[d12].Value = "Celula Interior Colorindex Bloco 1 = [ " & Cells(1, 1).Interior.ColorIndex & " ]"
[d13].Value = "Celula Font Colorindex Bloco 1 = [ " & Cells(1, 1).Font.ColorIndex & " ]"
[d14].Value = "'- - - - - -'"
[d15].Value = "Celula Interior Colorindex Bloco 2 = [ " & Cells(7, 1).Interior.ColorIndex & " ]"
[d16].Value = "Celula Font Colorindex Bloco 2 = [ " & Cells(7, 1).Font.ColorIndex & " ]"
[d17].Value = "'- - - - - -'"
[d18].Value = "Celula Interior Colorindex Bloco 3 = [ " & Cells(13, 1).Interior.ColorIndex & " ]"
[d19].Value = "Celula Font Colorindex Bloco 3 = [ " & Cells(13, 1).Font.ColorIndex & " ]"
[d20].Value = "'- - - - - -'"
[d21].Value = "Celula Interior Colorindex Bloco 4 = [ " & Cells(19, 1).Interior.ColorIndex & " ]"
[d22].Value = "Celula Font Colorindex Bloco 4 = [ " & Cells(19, 1).Font.ColorIndex & " ]"
[d23].Value = "'- - - - - -'"
[d24].Value = "Celula Interior Colorindex Bloco 5 = [ " & Cells(25, 1).Interior.ColorIndex & " ]"
[d25].Value = "Celula Font Colorindex Bloco 5 = [ " & Cells(25, 1).Font.ColorIndex & " ]"

[f12].Interior.ColorIndex = Cells(1, 1).Interior.ColorIndex
[f13].Interior.ColorIndex = Cells(1, 1).Font.ColorIndex
[f14].Value = "'- - - - - -'"
[f15].Interior.ColorIndex = Cells(7, 1).Interior.ColorIndex
[f16].Interior.ColorIndex = Cells(7, 1).Font.ColorIndex
[f17].Value = "'- - - - - -'"
[f18].Interior.ColorIndex = Cells(13, 1).Interior.ColorIndex
[f19].Interior.ColorIndex = Cells(13, 1).Font.ColorIndex
[f20].Value = "'- - - - - -'"
[f21].Interior.ColorIndex = Cells(19, 1).Interior.ColorIndex
[f22].Interior.ColorIndex = Cells(19, 1).Font.ColorIndex
[f23].Value = "'- - - - - -'"
[f24].Interior.ColorIndex = Cells(25, 1).Interior.ColorIndex
[f25].Interior.ColorIndex = Cells(25, 1).Font.ColorIndex
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.





: <<< Registre-se em nosso Site >>> acesse area para registrados.

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

Esses macros e funcoes personalizadas do Aplicativo MS Excel VBA(Visual Basic Application) retornam um número que esteja
concatenado com um Texto, multiplicando por uma determinado número em colunas especificas (Quantidade, preço etc..)
veja que o macro abaixo busca valores em (Strings) concatenadas e as multiplica por valores (quantidade) x preço)
baixe o exemplo de planiha para ver melhor (no final da página).
(Duvida do Riomar)

Sub chamando_funcao_via_vba()
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row 'i variavel para encontrar a linha
Cells(i, "F").Value = CDbl(Extrair_Numero(Cells(i, "c")) * Cells(i, "d")) 'cdbl (double se houver decimais)
Next i
End Sub

Function Extrair_Numero(vCell As Range)
Dim vContador As Long, l As Long
Dim vTexto As String
Dim vNum As String
vTexto = vCell
For vContador = Len(vTexto) To 1 Step -1
If IsNumeric(Mid(vTexto, vContador, 1)) Then
l = l + 1
vNum = Mid(vTexto, vContador, 1) & vNum
End If
If l = 1 Then vNum = CInt(Mid(vNum, 1, 1))
Next vContador
Extrair_Numero = CLng(vNum)
End Function

Sub Limpar_teste()
Range("F2:F" & Range("A65000").End(xlUp).Row).ClearContents
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.