About Me
Estatisticas
6:07 p.m. | 
Publicada por
JRod - PORTUGAL
'---------------------------------------------------------------------------------------
' Procedure : Test
' DateTime : 05-10-2007 17:57
' Author : JRod
' Purpose : Apagar Row da célula activa na Sheet1 e 1ª Row da Sheet2
' : cuja entrada seja igual à célula activa
'---------------------------------------------------------------------------------------
'
Sub Test()
Dim c As Range, myRange As Range
On Error Resume Next
Set myRange = Sheets(2).Range("A1:A100")
For Each c In myRange
If c.Value = ActiveCell.Value Then
c.EntireRow.Delete
End If
Next c
ActiveCell.EntireRow.Delete
End Sub
' Procedure : Workbook_Open
' DateTime : 05-10-2007 18:00
' Author : JRod
' Purpose : Abre Macro com click no botão direito do rato
'---------------------------------------------------------------------------------------
'
Private Sub Workbook_Open()
Dim MyMenu As Object
Set MyMenu = Application.ShortcutMenus(xlWorksheetCell) _
.MenuItems.AddMenu("A minha Macro", 1)
With MyMenu.MenuItems
.Add "Test", "Test", , 1, , ""
End With
Set MyMenu = Nothing
End Sub
Tópicos relacionados:
Recebi hoje a seguinte mensagem da Microsoft:
" Dear Jorge Rodrigues,
Congratulations! We are pleased to present you with the 2008 Microsoft® MVP Award!".
Ou seja, fui galardoado, pelo 3º ano consecutivo, Microsoft MVP Excel!!!
URRA!!!
Clicar no banner para aceder ao link
 |
Data: 24 de Outubro (15h00-18h30)
Local: Auditório dos Oceanos, Casino de Lisboa - Parque das Nações
Produtos: Microsoft Expression, Silverlight
Destinatários: Designers
Vejamos o exemplo:
Na folha1:
Private Sub Worksheet_Change(ByVal Target As Range)
'JRod - Microsoft [MVP] - Excel
'blog: http://EXCELer.blogspot.com
'site: http://www.exceler.org
'email1: mail@exceler.org
'email2: blog.exceler@netcabo.pt
'
Const WS_RANGE As String = "A2:A10"
Dim c As Range, myRange As Range
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
Set myRange = Sheets(1).Range("A2:A10")
For Each c In myRange
If c.Value = ActiveCell.Offset(-1, 0).Value Then
If c.Offset(0, 1).Value = "S" Then
MsgBox "O trabalhador encontra-se de Baixa." & Chr(10) & "Inserção Impossível!", Buttons:=vbInformation
ActiveCell.Offset(-1, 0).Activate
ActiveCell.Value = ""
End If
End If
Next
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Tópicos relacionados:
=SUMPRODUCT((MÊS(A1:A1000)=6)*B1:B1000)
Eu, resolvi apresentar a seguinte alternativa:
{=SUM((MONTH(A1:A1000)=6)*(B1:B1000))}'como um array, ou seja com CTRL+SHIFT+ENTER para obter {}
=SUMIF(A1:A1000;">="&DATE(2007;6;1);B1:B1000)-SUMIF(A1:A1000;">"&DATE(2007;6;30);B1:B1000)
Bom, a escolha é vossa!!!
Tópicos relacionados:
A imagem do que se pretende:
O segmento de Código, apenas para o fim em vista:
For Each C In Me.Controls
If TypeName(C) = "TextBox" Or TypeName(C) = "ComboBox" Then
If C.Value = "" Then
MsgBox "Por favor, preencha todos os campos!"
C.SetFocus
Exit Sub
End If
End If
Next
Créditos para Bill Manville
Tópicos relacionados:
O Código:
Sub Macro1()
Dim i, z, choice, balls(10)
Range("A17").Select 'Para referência da ActiveCell
For i = 0 To 9
balls(i) = i
Next
Randomize Timer
For i = 4 To 1 Step -1 ' da direita para a esquerda
For z = 100 To 1 Step -1
choice = 1 + Int((Rnd * (10 - 1)))
ActiveCell.Offset(0, i - 1).Value = balls(choice)
Next z
balls(choice) = 0
Next
End Sub
Tópicos relacionados:
O Código:
Private Sub Worksheet_Change(ByVal Target As Range)
'JRod - Microsoft [MVP] - Excel
'blog: http://EXCELer.blogspot.com
'site: http://www.exceler.org
'email1: mail@exceler.org
'email2: blog.exceler@netcabo.pt
'
Const WS_RANGE As String = "A1:A10"
Dim vValor As Long
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
ActiveCell.Offset(-1, 0).Activate
vValor = Application.ActiveCell.Value
Range("C5") = vValor
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Nota: O Código deve ser inserido no próprio módulo da Sheet activa.
Tópicos relacionados:
Há dias, num newsgroup, colocaram a questão de saber como se poderia ordenar um range dinâmico em termos de linhas, com o tipo de ordenação na horizontal (por linha) e da direita para a esquerda.
Tomemos o seguinte exemplo demonstrativo da pretensão e do consequente resultado:
O Código:
Sub SortRow()
'JRod
'
'Copyright 2007
Dim R, RowNum As Long
RowNum = ActiveSheet.UsedRange.Rows.Count
For R = 2 To RowNum + 1
Range("A" & R & ":E" & R).Sort key1:=Range("A" & R), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight
Next R
End Sub
Tópicos relacionados:
Por mail, colocaram-me a seguinte questão (adaptada):
"Estou a criar um registo de membros... contudo, dado que o seu número facilmente poderá chegar aos 50, corro o risco de criar entradas duplicadas.
Assim, e depois de mais uma visita ao Exceler encontrei um post sobre o assunto [post de 2004-12-16]. Mas, a solução apresentada não me pareceu funcionar com texto... Agradeço, se possível, a informação de se será possível aplicar ou não a texto... "
Várias soluções se podem apresentar.
Uma delas, por exemplo, será a utilização de "Data Validation". No exemplo seguinte, sempre que se escrever numa das células do Range um conteúdo duplicado, vai dar uma mensagem:
Como fazer:
Outra possibilidade, é utilizar uma fórmula [com o mesmo Range de exemplo (D1:D10)] - na célula E1: =IF(MAX(COUNTIF($D$1:$D$10;$D$1:$D$10))>1;"Duplicado";"")
e copiando até ao fim do range [no exemplo,E1:E10] - Neste caso, vai dar TODAS as entradas duplicadas no range D1:D10, ou seja, considera entrada duplicada as duas entradas:.
Outra possibilidade ainda será, se se pretender que apenas as entradas duplicadas sejam consideradas, então teremos, no exemplo, em F1:
=IF(D1="";"";IF(MATCH(D1;D$1:D$10;0)<ROW(D1);"Duplicado!";""))
e copiando de F1 até F10:
Tópicos relacionados: