VBA Excel | Função VBA - Retorne 'Sim' caso todos os conteúdos de um Range estejam Preenchidos, Caso contrário retorna 'Não'

Sabe aquele conjunto de colunas na planilha que desejamos checar para ver se estão preenchidas e em caso positivo, sinalizamos o 'Status' como "Sim"? Pois aqui está a dita-cuja:

Function AvaliaPreenchimento(rng As Range) As String

    ' Application: 

    '      Action: Essa função avalia o conteúdo de todas as ocorrências de um range, retornando "S" quando todos os conteúdos estiverem preenchidos e "N" quando no mínimo um deles estiver vazio.

    '      Author: André Bernardes

    '     Contact: brazilsalesforceeffectiveness@gmail.com

    '        Date: 10.07.24 - 13:55:54

    

    Dim cell As Range

    Dim todasPreenchidas As Boolean

    

    Let todasPreenchidas = True

    

    ' Percorre cada célula no range fornecido

    For Each cell In rng

        ' Verifica se a célula está vazia

        If cell.Value = "" Or cell.Value = "0" Or IsEmpty(cell.Value) Then

            Let todasPreenchidas = False

            Exit For ' Se encontrar uma célula vazia, não precisa verificar as outras

        End If

    Next cell

    

    ' Retorna o resultado conforme a condição

    If todasPreenchidas Then

        Let AvaliaPreenchimento = "S"

    Else

        Let AvaliaPreenchimento = "N"

    End If

End Function

Explicação do Código:

1. Função AvaliaPreenchimento: É a função principal que recebe como argumento um objeto Range do Excel (rng) e retorna uma string ("S" ou "N") dependendo do resultado da avaliação.

2. Declarando Variáveis:

   - cell As Range: Variável utilizada para percorrer cada célula dentro do intervalo rng.

   - todasPreenchidas As Boolean: Variável que armazenará se todas as células estão preenchidas.

3. Inicialização:

   - todasPreenchidas = True: Inicializa como verdadeiro, assumindo inicialmente que todas as células estão preenchidas.

4. Loop For Each:

   - Percorre cada célula (cell) dentro do intervalo rng.

   - Verifica se o valor da célula (cell.Value) está vazio ("") ou se é considerado vazio (IsEmpty(cell.Value)).

   - Se encontrar uma célula vazia, altera o valor de todasPreenchidas para False e sai do loop utilizando Exit For.

5. Retorno do Resultado:

   - Após o loop, a função verifica o valor de todasPreenchidas.

   - Se todas as células estiverem preenchidas (todasPreenchidas = True), retorna "S".

   - Caso contrário, retorna "N".

Como Usar a Função:

Para usar essa função no Excel, você pode seguir os passos abaixo:

1. Abra o Excel.

2. Pressione ALT + F11 para abrir o Editor VBA.

3. No Editor VBA, clique em Inserir > Módulo para adicionar um novo módulo.

4. Cole o código fornecido acima no módulo que foi criado.

5. Salve o módulo (por exemplo, como AvaliaPreenchimento).

6. No Excel, você pode usar a função AvaliaPreenchimento como uma fórmula em uma célula. Por exemplo:

   - Se você deseja verificar se as células A1:A10 estão preenchidas, você pode digitar =AvaliaPreenchimento(A1:A10) em qualquer célula e pressionar Enter.

   - A célula irá mostrar "S" se todas as células de A1 a A10 estiverem preenchidas, ou "N" se pelo menos uma delas estiver vazia.

Espero que isso ajude! Se precisar de mais alguma coisa ou tiver alguma dúvida adicional sobre VBA ou Excel, estou à disposição para ajudar.

  Clique aqui e nos contate via What's App para avaliarmos seus projetos 

Envie seus comentários e sugestões e compartilhe este artigo!

brazilsalesforceeffectiveness@gmail.com

 Série de Livros nut Project 

   

    

VBA Excel Basic - Configurando Altura da Linha e Largura da Coluna - How To Set The Row Height And Column Width

Consultancy in Excel, Access, VBA & PowerPoint projects

DESENVOLVO APLICAÇÕES

Perguntas, Questões e Esclarecimentos

Sim, este é mais um tópico voltado para quem está iniciando na utilização do VBA - Visual Basic for Application no MS Excel.

Quando colamos dados em um relatório, invariavelmente queremos formatar o layout desses dados. Aqui, aprendemos como automatizar o acerto das Linhas e Colunas onde os nossos dados ficarão.

Ajustar a altura das Linhas e a Largura das Colunas, fará com que os dados analisados fiquem mais compreensíveis aos usuários que os analisarão.

Sub sbExample13()

    

    Rows(12).RowHeight = 33

    Columns(5).ColumnWidth = 35

End Sub

Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...

Tags: VBA, Excel, worksheet, workbook, Rows, Columns, Height, Column, largura, altura, linha, coluna, planilha, pasta,

VBA Excel - Deletando linhas duplicadas - Delete duplicate rows

Consultancy in Excel, Access, VBA & PowerPoint projects

DESENVOLVO APLICAÇÕES

Perguntas, Questões e Esclarecimentos

Vez por outra colamos bases de dados no MS Excel para efetuarmos análises, e sem que nos apercebamos, ou devido a uma base mal consolidada, encontramos os dados duplicados.
Como efetuar uma depuração que retire as ocorrências duplicadas deixando somente uma versão de cada registro?
A solução abaixo é o resultado de tal necessidade. 

Public Sub DelDupliRows (rng As Range)' Author:                  Date:                   Contact:' André Bernardes 29/01/2009 12:18 bernardess@gmail.com' Esta SUB deletará registros (linhas) duplicadas, será baseada no Range passado' como parâmetro. Quando esta SUB achar mais duma ocorrência no mesmo Range,' todas as ocorrências seguintes serão deletadas.
Dim r As LongDim n As LongDim v As Variant
On Error GoTo EndMacro
Let Application.ScreenUpdating = FalseLet Application.Calculation = xlCalculationManualLet Application.StatusBar = "Linha sendo processada: " & _ Format(rng.Row, "#,##0")
Let n = 0
For r = rng.Rows.Count To 2 Step -1If r Mod 500 = 0 ThenLet Application.StatusBar = "Processing Row: " & Format(r, "#,##0")End If
Let v = rng.Cells(r, 1).Value
If v = vbNullString ThenIf Application.WorksheetFunction.CountIf(rng.Columns(1), vbNullString) > 1 Thenrng.Rows(r).EntireRow.DeleteLet n = n + 1End IfElseIf Application.WorksheetFunction.CountIf(rng.Columns(1), v) > 1 Thenrng.Rows(r).EntireRow.DeleteLet n = n + 1End IfEnd IfNext r
EndMacro:Let Application.StatusBar = FalseLet Application.ScreenUpdating = TrueLet Application.Calculation = xlCalculationAutomatic
MsgBox CStr(n) & "Linha(s) Duplicada(s) Deleta(s) "End Sub

Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...

Tags: VBA, Excel, Column, Coluna, Delete, Linha, Plan, Planilhas, Report, Row,  rows,worksheet, lines, duplicate, duplicado, dados, paste, cut

VBA Excel - Retornando o Limite da Coluna de um Range

|Blog Office VBA | Blog Excel | Blog Access | Blog Infochart | 

DESENVOLVO APLICAÇÕES VBA

O que é o fenômeno chamado BIG DATA?

Acesse uma ENORME lista de Dashboards e Infográficos

Aprenda a detectar gráficos que precisam mudar

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Dashboards e Infocharts - Diversas Visualizações de Dados

Diversos exemplos de Gráficos

Excel - DashMap - Mapa do Brasil

Key Performance Indicators - 7 Características desejáveis

MIS - Usufruindo a excelência na análise das suas Informações

O Melhor do Business Intelligence

Os 10 mandamentos do gerenciamento de projetos

Receba  3 Calendários Customizáveis de  2013 em Excel

Usando Gauges em Dashboards no MS Access

Como faço para descobrir a última coluna com dados numa Planilha?

Function LASTINCOLUMN (rngInput As Range)

    ' Author:                     Date:               Contact:

    ' André Bernardes             11/08/2008 09:01    bernardess@gmail.com

    '

    Dim WorkRange As Range

    Dim i As Integer, CellCount As Integer

    

    Application.Volatile

    Set WorkRange = rngInput.Columns(1).EntireColumn

    Set WorkRange = Intersect(WorkRange.Parent.UsedRange, WorkRange)

    

    Let CellCount = WorkRange.Count

    For i = CellCount To 1 Step -1

        If Not IsEmpty(WorkRange(i)) Then

            Let LASTINCOLUMN = WorkRange(i).Value

            Exit Function

        End If

    Next i

End Function

Tags: VBA, Excel, UDF, Column, coluna, last, última

VBA Excel - Manipulando as linhas e colunas

| Blog Office VBA | Blog Excel | Blog Access |

+ de 100.000 VISITAS

Acesse: http://goo.gl/0v6AO   

Já tive a oportunidade de disponibilizar aqui outros modos de como identificar qual é a última linha (ou o último registro) numa planilha de dados. Entre todas as técnicas de VBA, esta é uma das melhores. 

Para ser breve e suscinto, as outras técnicas volta e meia eram falhas devido a dirty area.

Depois de algum tempo alguns programadores acharam a melhor técnica para identificarmos a última ocorrência sem falhas. O exemplo abaixo é uma variante da técnica ensinada pelo Excel MVP, Bob Umlas. Testem naquelas bases de dados mais parrudas, com grandes quantidades de dados, acima de 100.000 linhas e vejam o excelente resultado.

CÓDIGO: SELECIONAR TUDO

Function LCell(ws As Worksheet) As Range
  Dim LRow&, LCol%

  On Error Resume Next

  With ws
    Let LRow& = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    Let LCol%   = .Cells.Find(What:="*", SearchDirection:=xlPrevious,  SearchOrder:=xlByColumns).Column
  End With

  Set LCell = ws.Cells(LRow&, LCol%)
End Function

Usando esta função:
A função LCell demonstrada aqui não poderá ser utilizada diretamente em uma planilha, mas poderá ser evocada a partir de outro procedimento VBA. Implemente o código como abaixo:

CÓDIGO: SELECIONAR TUDO

Sub Identifica()
   MsgBox LCell(Sheet1).Row
End Sub

Outra contribuição interessante é essa cuja a função retorna diretamente o número da última linha, inclusive para uma célula de planilha, contribuição de Adilson Soledade neste Fórum da Info, num tópico que iniciei:

CÓDIGO: SELECIONAR TUDO

Function LRow(Ref As Range) As Integer
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = Ref.Parent
    LRow = ws.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
End Function

Muitas e muitas vezes, vejo postado em diversos outros fóruns ao redor da WEB, pessoas pedindo uma macro para excluir todas as linhas em branco ou todas as linhas duplicadas de uma série de linhas em uma planilha.

Aqui tem três códigos: 
Bernardes_DeleteBlankRows, 
Bernardes_DeleteRowOnCell, e
Bernardes_DeleteDuplicateRows.

Lembre-se, estas macros apagam linhas inteiras de sua planilha, não excluem células individuais.

Excluindo linhas em branco

O código Bernardes_DeleteBlankRows descrito a seguir irá apagar todas as linhas em branco na planilha especificada pelaWorksheetName parâmetro. Se este parâmetro for omitido, a planilha ativa será utilizada. O procedimento apagará as linhas que estiverem totalmente em branco ou contiverem células cujo o conteúdo seja apenas um único apóstrofe (caracter que controla a formatação). O procedimento exige a função IsRowClear, mostrada após o procedimento Bernardes_DeleteBlankRows. 

Não apagará as linhas que contém fórmulas, mesmo que a fórmula retorne um valor vazio. A função não excluirá as linhas precedentes de uma fórmula em uma célula se as linhas precedentes tiverem menor número de linhas que a linha. No entanto, se uma fórmula referir-se a uma série de linhas com números mais altos do que as células que contém a fórmula, e as linhas forem totalmente em branco, as linhas referenciadas pela fórmula serão excluídas. Portanto, a referência da fórmula pode ser alterada nas linhas acima da fórmula excluída.

CÓDIGO: SELECIONAR TUDO

Sub Bernardes_DeleteBlankRows(Optional WorksheetName As Variant)
' This function will delete all blank rows on the worksheet
' named by WorksheetName. This will delete rows that are
' completely blank (every cell = vbNullString) or that have
' cells that contain only an apostrophe (special Text control
' character).
' The code will look at each cell that contains a formula,
' then look at the precedents of that formula, and will not
' delete rows that are a precedent to a formula. This will
' prevent deleting precedents of a formula where those
' precedents are in lower numbered rows than the formula
' (e.g., formula in A10 references A1:A5). If a formula
' references cell that are below (higher row number) the
' last used row (e.g, formula in A10 reference A20:A30 and
' last used row is A15), the refences in the formula will
' be changed due to the deletion of rows above the formula.

Dim RefColl As Collection
Dim RowNum As Long
Dim Prec As Range
Dim Rng As Range
Dim DeleteRange As Range
Dim LastRow As Long
Dim FormulaCells As Range
Dim Test As Long
Dim WS As Worksheet
Dim PrecCell As Range

If IsMissing(WorksheetName) = True Then
    Set WS = ActiveSheet
Else
    On Error Resume Next
    Set WS = ActiveWorkbook.Worksheets(WorksheetName)
    If Err.Number <> 0 Then
        '''''''''''''''''''''''''''''''
        ' Invalid worksheet name.
        '''''''''''''''''''''''''''''''
        Exit Sub
    End If
End If

If Application.WorksheetFunction.CountA(WS.UsedRange.Cells) = 0 Then
    ''''''''''''''''''''''''''''''
    ' Worksheet is blank. Get Out.
    ''''''''''''''''''''''''''''''
    Exit Sub
End If

' Find the last used cell on the
' worksheet.
''''''''''''''''''''''''''''''''''''''
Set Rng = WS.Cells.Find(what:="*", after:=WS.Cells(WS.Rows.Count, WS.Columns.Count), lookat:=xlPart, _
    searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False)

Let LastRow = Rng.Row

Set RefColl = New Collection

'''''''''''''''''''''''''''''''''''''
' We go from bottom to top to keep
' the references intact, preventing
' #REF errors.
'''''''''''''''''''''''''''''''''''''
For RowNum = LastRow To 1 Step -1
    Set FormulaCells = Nothing
    If Application.WorksheetFunction.CountA(WS.Rows(RowNum)) = 0 Then
        ''''''''''''''''''''''''''''''''''''
        ' There are no non-blank cells in
        ' row R. See if R is in the RefColl
        ' reference Collection. If not,
        ' add row R to the DeleteRange.
        ''''''''''''''''''''''''''''''''''''
        On Error Resume Next
        Test = RefColl(CStr(RowNum))
        If Err.Number <> 0 Then
            ''''''''''''''''''''''''''
            ' R is not in the RefColl
            ' collection. Add it to
            ' the DeleteRange variable.
            ''''''''''''''''''''''''''
            If DeleteRange Is Nothing Then
                Set DeleteRange = WS.Rows(RowNum)
            Else
                Set DeleteRange = Application.Union(DeleteRange, WS.Rows(RowNum))
            End If
        Else
            ''''''''''''''''''''''''''
            ' R is in the collection.
            ' Do nothing.
            ''''''''''''''''''''''''''
        End If
        On Error GoTo 0
        Err.Clear
    Else
        '''''''''''''''''''''''''''''''''''''
        ' CountA > 0. Find the cells
        ' containing formula, and for
        ' each cell with a formula, find
        ' its precedents. Add the row number
        ' of each precedent to the RefColl
        ' collection.
        '''''''''''''''''''''''''''''''''''''
        If IsRowClear(RowNum:=RowNum) = True Then
            '''''''''''''''''''''''''''''''''
            ' Row contains nothing but blank
            ' cells or cells with only an
            ' apostrophe. Cells that contain
            ' only an apostrophe are counted
            ' by CountA, so we use IsRowClear
            ' to test for only apostrophes.
            ' Test if this row is in the
            ' RefColl collection. If it is
            ' not in the collection, add it
            ' to the DeleteRange.
            '''''''''''''''''''''''''''''''''
            On Error Resume Next
            Test = RefColl(CStr(RowNum))
            If Err.Number = 0 Then
                ''''''''''''''''''''''''''''''''''''''
                ' Row exists in RefColl. That means
                ' a formula is referencing this row.
                ' Do not delete the row.
                ''''''''''''''''''''''''''''''''''''''
            Else
                If DeleteRange Is Nothing Then
                    Set DeleteRange = WS.Rows(RowNum)
                Else
                    Set DeleteRange = Application.Union(DeleteRange, WS.Rows(RowNum))
                End If
            End If
        Else
            On Error Resume Next
            Set FormulaCells = Nothing
            Set FormulaCells = WS.Rows(RowNum).SpecialCells(xlCellTypeFormulas)
            On Error GoTo 0
            If FormulaCells Is Nothing Then
                '''''''''''''''''''''''''
                ' No formulas found. Do
                ' nothing.
                '''''''''''''''''''''''''
            Else
                '''''''''''''''''''''''''''''''''''''''''''''''''''
                ' Formulas found. Loop through the formula
                ' cells, and for each cell, find its precedents
                ' and add the row number of each precedent cell
                ' to the RefColl collection.
                '''''''''''''''''''''''''''''''''''''''''''''''''''
                On Error Resume Next
                For Each Rng In FormulaCells.Cells
                    For Each Prec In Rng.Precedents.Cells
                        RefColl.Add Item:=Prec.Row, key:=CStr(Prec.Row)
                    Next Prec
                Next Rng
                On Error GoTo 0
            End If
        End If
        
    End If
    
    '''''''''''''''''''''''''
    ' Go to the next row,
    ' moving upwards.
    '''''''''''''''''''''''''
Next RowNum

''''''''''''''''''''''''''''''''''''''''''
' If we have rows to delete, delete them.
''''''''''''''''''''''''''''''''''''''''''

If Not DeleteRange Is Nothing Then
    DeleteRange.EntireRow.Delete shift:=xlShiftUp
End If
End Sub

Function IsRowClear(RowNum As Long) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''
' IsRowClear
' This procedure returns True if all the cells
' in the row specified by RowNum as empty or
' contains only a "'" character. It returns False
' if the row contains only data or formulas.
''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ColNdx As Long
Dim Rng As Range
ColNdx = 1
Set Rng = Cells(RowNum, ColNdx)
Do Until ColNdx = Columns.Count
    If (Rng.HasFormula = True) Or (Rng.Value <> vbNullString) Then
        IsRowClear = False
        Exit Function
    End If
    Set Rng = Cells(RowNum, ColNdx).End(xlToRight)
    ColNdx = Rng.Column
Loop

Let IsRowClear = True

End Function

Este código, Bernardes_DeleteBlankRows, excluirá uma linha, se toda a linha estiver em branco. Apagará a linha inteira se uma célula na coluna especificada estiver em branco. Somente a coluna marcada, outras são ignoradas.

CÓDIGO: SELECIONAR TUDO

Public Sub Bernardes_DeleteRowOnCell() 

         On Error Resume Next 

         Selection.SpecialCells (xlCellTypeBlanks). EntireRow.Delete 

         ActiveSheet.UsedRange 

End Sub

Para usar este código, selecione um intervalo de células por colunas e, em seguida, execute o código. Se a célula na coluna estiver em branco, a linha inteira será excluída. Para processar toda a coluna, clique no cabeçalho da coluna para selecionar a coluna inteira.

Este código eliminará as linhas duplicadas em um intervalo. Para usar, selecione uma coluna como intervalo de células, que compreende o intervalo de linhas duplicadas a serem excluídas. Somente a coluna selecionada é usada para comparação. 

CÓDIGO: SELECIONAR TUDO

Sub Bernardes_DeleteDuplicateRows Pública () 
''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''' 
'DeleteDuplicateRows 
"Isto irá apagar registros duplicados, com base na coluna ativa. Ou seja, 
"se o mesmo valor é encontrado mais de uma vez na coluna activa, mas todos 
"os primeiros (linha número mais baixo) serão excluídos. 
" 
'Para executar a macro, selecione a coluna inteira que você deseja escanear 
'duplica e executar este procedimento. 
'''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''' 
R Dim As Long 
Dim N Long 
V Variant Dim 
Dim Rng Gama 

On Error GoTo EndMacro 
Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

Set Rng = Application.Intersect (ActiveSheet.UsedRange, _ 
ActiveSheet.Columns (ActiveCell.Column)) 

Let Application.StatusBar = "Processamento de Linha:" & Format (Rng.Row , "#,## 0 ") 
Let N = 0 
Let R = Rng.Rows.Count To 2 Step -1 

IF Mod R 500 = 0 Then 
    Let Application.StatusBar = "Linha de processamento:" & Format (R ", # # 0 ") 
End If 

? = Rng.Cells (R, 1). Valor V 
'''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''' 
Nota "que COUNTIF obras estranhamente com uma variante que é igual a vbNullString. 
" Ao invés de passar na variante, você precisa passar vbNullString explicitamente. 
''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''' 
Let V = vbNullString Então 
Let Application.WorksheetFunction. CONT.SE (Rng.Columns (1), vbNullString)> 1 Então 
Rng.Rows (R). EntireRow.Delete 
Let N = N + 1 
End If 
Else 
Se Application.WorksheetFunction.CountIf (Rng.Columns (1), V)> 1 Então, 
(R). Rng.Rows EntireRow.Delete 
Let N = N + 1 
End If 
End If 
Next R 

EndMacro: 

Let Application.StatusBar = False 
Let Application.ScreenUpdating = True 
Let Application.Calculation = xlCalculationAutomatic 
MsgBox "Duplicar linhas excluídas:" & CStr (N ) 

End Sub

Tags: VBA, excel, dirty area, column, row, linha, coluna, delete,