Search

A carregar...

Blog Archive

About Me

A minha fotografia
JRod - PORTUGAL
Microsoft [MVP] - Excel (10º ano consecutivo)
Ver o meu perfil completo
Com tecnologia do Blogger.

Seguidores

Estatisticas

Free Blog Counter

eXTReMe Tracker
Ocorreu um erro neste dispositivo
2006-12-21

No último post, vimos como se podiam colar dados na Folha2 provenientes da Folha1. Mas e se os dados a serem colados forem provenientes de selecções múltiplas, ou seja, de ranges não contínuos? Como efectuar estas cópias múltiplas e como colar na Folha2 , mas de modo contínuo, linha a linha?

Para uma melhor compreensão, vejamos o exemplo:

 Escolha na Folha1:

 

Resultado na Folha2:

O Código:

Para o Command Button:

Private Sub Teste_Click()
    Call Faz_Tudo
End Sub

Num módulo VBE:

Option Explicit
Sub Faz_Tudo()


    Dim LotsOfRanges() As Range
    Dim rangeCtr As Long
    Dim myRange As Range
    Dim myArea As Range
    Dim i As Long
    Dim destrange As Range


    rangeCtr = 0
    Do
        On Error Resume Next
        Set myRange = Nothing
        Set myRange = Application.InputBox(prompt:="Seleccionar o Range" _
                                & rangeCtr + 1, _
                              Title:="Any Range", _
                              Default:=Selection.Address, _
                              Type:=8)
        On Error GoTo 0
        If myRange Is Nothing Then
            'Cancelamento pelo utilizador
            Exit Do
        Else
            rangeCtr = rangeCtr + 1
            ReDim Preserve LotsOfRanges(1 To rangeCtr)
            Set LotsOfRanges(rangeCtr) = myRange
        End If
    Loop


    If rangeCtr = 0 Then
        'Cancela o primeiro e sai
        
        Exit Sub
    End If


    If MsgBox("Pronto para processar os Ranges?", vbYesNo) = vbNo Then
        Exit Sub
    End If


    For i = LBound(LotsOfRanges) To UBound(LotsOfRanges)
        For Each myArea In LotsOfRanges(i).Areas
        
        
                Set destrange = Sheets("Sheet2").Range("A" & _
                                               LastRow(Sheets("Sheet2")) + 1)
        myArea.Copy
        destrange.PasteSpecial xlPasteValues, , False, False
        Application.CutCopyMode = False
        Next myArea
    Next i


End Sub


Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

2006-12-15

A propósito do post de 2006-12-03 (agora catalogado com o nº 173), fizeram a seguinte pergunta:

"O código só copia e cola as celulas A, B,C e D da linha seleccionada se a célula da coluna A estiver seleccionada. Se a célula da coluna D estiver seleccionada vai copiar e colar as células à direita da mesma, ora o que eu pretendia se possivel era:

Nas colunas A, B, C estão inscritos dados que não serão alterados (Lista ou base dados) e na coluna D irá escrever-se o nº de unidades pedidas. Após a inscrição das unidades pedidas na coluna D, activar-se-ia o CommandBoton para que o pedido passasse para a Folha2, colando os dados que estão nas colunas A, B, C e D dessa linha e o pedido seguinte na linha imediatamente a seguir."

 

Neste caso, o Código deverá ser alterado para o seguinte:

 

Private Sub CommandButton2_Click()

    Dim MyNum

    For MyNum = 2 To 50

        If ActiveCell.Address = Range("D" & MyNum).Address Then
            Range(ActiveCell, ActiveCell.Offset(0, -3)).Copy Destination:= _
                                                             Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            msg = MsgBox(Prompt:="Copiou com sucesso", Title:="Informação")
        End If

    Next MyNum

End Sub

Ou seja, se a célula activa estiver na coluna D (no código acima é uma das células da coluna D compreendida entre D2 e D50), efectua a cópia e dá mensagem de bem sucedida a cópia, caso contrário, ou seja, se a célula activa não for uma célula da coluna D, não copia nada, pura e simplesmente.

2006-12-14

Para apagar, na ultima linha editada, os valores das células correspondentes às colunas A, B , C , D e E, como no exemplo:

 

 

 

Podemos utilizar o seguinte Código:

 

Private Sub CommandButton1_Click()


    i = 5
    t = True


    While t = True
        i = i + 1
        If Cells(i, 1).Value = "" Then t = False
    Wend


    Range("a" & (i - 1)).Select
    Range(ActiveCell, ActiveCell.Offset(0, 4)).ClearContents


End Sub

2006-12-12
Se se pretender mudar a célula selecionada para uma outra na mesma linha mas na coluna "A", que código utilizar para mover a selecção, tendo em conta que a selecção inicial pode estar a 1, 2, 3, etc. células de "distância" na mesma linha?

Ex:

de



para



O Código do CommandButton:

Private Sub CommandButton2_Click()
    Cells(ActiveCell.Row, 1).Activate
End Sub
2006-12-03
Se pretendermos copiar um determinado range de uma Sheet para uma outra Sheet, mas para a linha vazia seguinte e mantendo dados em outras células da mesma linha onde se pretendem colar os dados, como no exemplo seguinte:







Podemos utilizar o seguinte Código num CommandButton:

Private Sub CommandButton1_Click()
    Range(ActiveCell, ActiveCell.Offset(0, 3)).Copy Destination:= _
                              Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End Sub


Nota: Neste exemplo, torna-se necessário que a ActiveCell seja sempre uma célula da coluna "A"
2006-11-09
Se, por exemplo, na Sheet3, em A3, pretendermos ter o resultado da soma de A1 da Sheet1 com A1 da Sheet2, então, podemos digitar:

=SUM('*'!A1), quando damos Enter, a fórmula transforma-se em: =SUM(Sheet1:Sheet2!A1)


Também tem o mesmo resultado, a seguinte fórmula: =SUM('She*'!A1) e a seguinte, também: =SUM('Sheet?'!A1)


Ou seja, a utilização de qualquer destas wild cards, tem o mesmo resultado.


Nota: também dá para outro tipo de fórmulas, como seja, MAX, MIN, AVERAGE, etc.

Créditos para Lori Miller
2006-11-01
Se tivermos uma tabela na Sheet2, como no exemplo:



e pretendermos copiar o conteúdo das colunas B e C, por linha para a Sheet1, como no exemplo:



podemos correr o risco de perdermos a formatação inicial na Sheet1, no que diz respeito ao valor, se utilizarmos o seguinte Código:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Set rng1 = ActiveCell      'Clicar duplamente sempre numa célula da coluna A,
                               'para que a função Offset() possa indicar o número da célula pretendida
    Set rng2 = rng1.Offset(0, 1)
    Set rng3 = rng1.Offset(0, 2)

    rng2.Copy Destination:=Worksheets("Sheet1").[B3:D3]    ' Range, porque são merged cells
    rng3.Copy Destination:=Worksheets("Sheet1").[E3]  'altera a formatação no destino - é valor

    Range("A1").Select    ' Esta selecção de A1, é apenas para desactivar a ActiveCell
End Sub



Aqui, o resultado seria o seguinte:



Então, para que o resultado seja o desejado, isto é, sem perder a formatação original no destino:






teremos que aperfeiçoar o Código:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Set rng1 = ActiveCell      'Clicar duplamente sempre numa célula da coluna A,
                               'para que a função Offset() possa indicar o número da célula pretendida
    Set rng2 = rng1.Offset(0, 1)
    Set rng3 = rng1.Offset(0, 2)

    rng2.Copy Destination:=Worksheets("Sheet1").[B3:D3]    ' Range, porque são merged cells
    rng3.Copy
    Worksheets("Sheet1").[E3].PasteSpecial (xlValues)
'não altera a formatação no destino apesar de ser valor
    
    [A1].Select    ' Esta selecção de A1, é apenas para desactivar a ActiveCell
End Sub


NOTA: O Código VBA deve ser inserido na Sheet2, clicando com o botão direito do rato no tabulador (para aceder ao Editor de VBA) e escolhendo:

2006-10-23
Se pretendermos inserir uma TextBox proveniente do menu Draw num qualquer local de uma Worksheet e que essa TextBox contenha o mesmo conteúdo de uma determinada célula, como no exemplo:



podemos fazê-lo da seguinte maneira:

  • Criamos a TextBox:



  • Renomeamos a TextBox e damos-lhe o valor igual à célula que pretendemos (no exemplo, C2):



O resultado será o esperado:



E agora, se pretendermos que o valor que temos na TextBox seja inserido numa qualquer célula (no exemplo, C8), então teremos que atribuir uma macro àquela TextBox:



E o resultado será:




O Código da macro:

Sub TboxValueInCell()
    Dim ws1 As Worksheet
    Dim rng As Range
    Dim tb As TextBox
    Dim newtext

    Set ws1 = Sheets("Sheet1")
    Set rng = ws1.Range("C8")
    Set tb = ws1.TextBoxes("Text01")
    
    newtext = tb.Text
    rng = newtext

End Sub
2006-10-18
Se pretendermos copiar o conteúdo de determinadas células contidas numa linha para outra Sheet e para células diferentes, como no exemplo:



O resultado:



Podemos utilizar a chamada OffSet Property.

Nota1: Para copiar o conteúdo da linha pretendida da Sheet1 para a Sheet2, faz-se um duplo clic na célula da coluna A cuja linha queremos copiar
Nota2: Para colocar o Código VBA, clicar no tabulador da Sheet1 com o botão direito do rato e escolher View Code

O Código:

'---------------------------------------------------------------------------------------
' Procedure : Worksheet_BeforeDoubleClick
' DateTime  : 18-10-2006 15:25
' Author    : JRod
' Purpose   : Copiar conteúdo de células da Sheet1 para células diferentes da Sheet2
'---------------------------------------------------------------------------------------
'
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Set rng1 = ActiveCell
    Set rng2 = rng1.Offset(0, 1)
    Set rng3 = rng1.Offset(0, 2)
    Set rng4 = rng1.Offset(0, 3)

    rng1.Copy Destination:=Worksheets("Sheet2").Range("D4:E4")
    rng2.Copy Destination:=Worksheets("Sheet2").Range("G4:H4")
    rng3.Copy Destination:=Worksheets("Sheet2").Range("C4")
    rng4.Copy Destination:=Worksheets("Sheet2").Range("C7:D7")

    Range("A1").Select
    
End Sub


  • Tópicos relacionados


  •  OffSet Property
     CurrentRegion Property
     
     
    2006-10-09
    Vejamos o seguinte exemplo:



    Se pretendermos copiar este segmento para uma outra worksheet, normalmente o que acontecerá, é isto:



    Então, o que poderemos fazer, será:



    ou seja, clica-se no quadrado da intersecção entre a coluna A e a linha1.

    Depois, clica-se no ícone "Format Painter". O resultado será a marcação de toda a worksheet:



    De seguida, passa-se para a nova worksheet onde queremos efectuar o "Paste" e, de novo no quadrado da intersecção da coluna A com a linha 1, faz-se um click ( de notar que a imagem do Format Painter está associada ao apontador ):



    O resultado será, então, o desejado:









    2006-10-03
    Se pretendermos extrair um determinado conteúdo de uma célula que contém letras e números, como no exemplo:



    podemos utilizar, no primeiro caso, as Funções LEFT() e FIND() e no segundo, as Funções RIGHT(), LEN() e FIND():





    2006-10-01
    É com grande orgulho que torno público que a Microsoft me reconheceu, pelo segundo ano consecutivo, como Microsoft Most Valuable Professional MVP-EXCEL
    2006-09-28
    Se pretendermos inserir uma imagem numa folha de cálculo e dentro de uma "Image box control", como no exemplo:








    podemos utilizar um pouco de Código:

    Option Explicit


    Private Sub CommandButton1_Click()

        Dim myPictName As Variant
        Dim Image1 As Image

        myPictName = Application.GetOpenFilename _
                        (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif")
        If myPictName = False Then
            Exit Sub
        End If


       Me.Image1.Picture = LoadPicture(myPictName)

    End Sub


    2006-09-25

    Se numa tabela de nomes pretendermos filtrar um determinado nome (ex: António), o qual pode ser nome próprio, nome do meio ou apelido, podemos utilizar um pouco de VBA:












    O Código:

    Private Sub CommandButton1_Click()
    Dim myName

        Range("A1:A700").Select
        myName = InputBox(Prompt:="Digite o nome para filtro ou carregue em OK para remover filtro", Title:="Filtra por nome")

        If myName = "" Then
            Selection.AutoFilter
            Range("A1").Select
        Else
            Selection.AutoFilter Field:=1, Criteria1:="*" & myName & "*", Operator:=xlAnd
            Range("A1").Select
        End If

    End Sub


    NOTA: O asterisco funciona como um "multi character wild card".

  • Tópicos relacionados


  •  WildCards (1) (Microsoft Support Center)

     WildCards (2) (digdb.com)

     Filtros (1) (por Debra Dalgleish)

     Filtro (2) (Joseph Rubin's Exceltip.com)

    2006-09-12

    2006-09-09
    Se pretendermos utilizar um ficheiro texto (ex: teste.txt) como um ficheiro com conteúdo numérico sequenciador para uma célula de uma worksheet (ex: A1), então, podemos criar o ficheiro, digitar 0 (zero) e salvá-lo no directório escolhido. Depois, um pouco de VBA adicionado a um Command Button, faz o resto.





    O Código:

    Private Sub CommandButton1_Click()
        Dim strTemp As String

        On Error GoTo CommandButton1_Click_Error

        Open "F:\Gabinete\teste.txt" For Input As #1

        Line Input #1, strTemp
        Range("A1").Value = strTemp + 1
        Close #1

        Open "F:\Gabinete\teste.txt" For Output As #1

        strTemp = Range("A1").Value
        Print #1, strTemp
        Close #1

        On Error GoTo 0
        Exit Sub

    CommandButton1_Click_Error:

        MsgBox "Erro " & Err.Number & " (" & Err.Description & ") no procedimento CommandButton1_Click"
    End Sub


  • Tópicos relacionados:


  •  Open Statement
    2006-08-15
    Consideremos o seguinte sistema de equações: x + y =8 e x - y = 2

    Assim, na 2ª equação, teriamos: x= y+2. Então, na 1ª equação teríamos com a substituição de x: y + 2 + y = 8 ou seja: 2y = 6 ou seja: y = 6/2 ou seja: y = 3

    Então, na 2ª equação teríamos com a substituição de y pelo seu resultado: x - 3 = 2 ou seja: x = 5

    Como resolver este problema no Excel?

    Com a ajuda do Add-in SOLVER, é possível. Vejamos o exemplo:

    Nota - definiu-se C2 como x e C3 como y (Insert|Name|Define)
                B2 é igual a 8, ou seja: x + y
                B3 é igual a 2, ou seja: x - y








    O resultado: