Página 1 de 1

Preencher e Excluir Células - VBA

Enviado: 16 Ago 2017 às 09:47
por DiegoMatos
Mestres,

Preciso de um código que faça a seguinte sequencia na planilha anexa:

* Preencher com o código SAP e Descrição Breve as células em branco até o próximo código SAP diferente
*Excluir as linhas a partir de FABRICANTE (MANUFACTURER): para cima, conforme exemplo na coluna D, porém de todos os códigos SAP.

Certo da colaboração, desde já agradeço.

Re: Preencher e Excluir Células - VBA

Enviado: 16 Ago 2017 às 10:43
por osvaldomp
Você marcou que deseja excluir a linha 2. É para excluir também as linhas 16, 30, ... ?

sugestão - disponibilize outra planilha e coloque também o resultado desejado ao lado de ao menos 3 grupos de dados (códigos 31607, 33668 e 33698)

Preencher e Excluir Células - VBA

Enviado: 16 Ago 2017 às 10:54
por DiegoMatos
Osvaldo, obrigado pela mensagem.

Sim, estou mandando a planilha de com o resultado desejado.

Att,

Diego Matos

Re: Preencher e Excluir Células - VBA

Enviado: 16 Ago 2017 às 17:11
por osvaldomp
Diego, faça os testes com o código abaixo.
Aqui o código processou as 145 mil linhas em aprox 2 min.
Na sua tabela há mais de 1.200 blocos sem o termo "FABRICANTE" e estes blocos não serão processados pelo código.
Código: Selecionar todos
Sub OrganizaDados()
 Dim LR As Long, k As Long, m As Long, v As Long, f As Range
 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False
  LR = Cells(Rows.Count, 3).End(3).Row
   For k = LR To 2 Step -1
     m = Cells(k, 1).End(3).Row
     Set f = Range(Cells(m + 1, 3), Cells(k, 3)).Find("FABRICANTE", lookat:=xlPart)
      If f Is Nothing Then
       v = v + 1: GoTo nof
      End If
     Range(Cells(m + 1, 1), Cells(k, 2)).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
     Range(Cells(m + 1, 1), Cells(k, 2)).Value = Range(Cells(m + 1, 1), Cells(k, 2)).Value
     Rows(m & ":" & f.Row).Delete
nof:
     k = m + 1
     If m = 2 Then Exit For
   Next k
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 If v > 0 Then MsgBox "encontrados " & v & " blocos sem FABRICANTE"
End Sub