Notifications

Clear all

[Resolvido] Limpezas de dados e Exclusão de linhas

2024 - VBA & Macros

Post Recente por fabio.cmaa 4 anos atrás

7 Posts

2 Usuários

2 Reactions

1,179 Visualizações

RSS

fabio.cmaa

(@fabio-cmaa)

Posts: 0

Estimable Member

Topic starter

Bom dia Pessoal,

gostaria de uma ajuda de vocês,

estou com um problema na macro, toda vez que eu executo ela, o campo data fica de forma errada, porem, se eu fizer todo o processo manual, não dar erro,

a primeira aba, é o arquivo original,

a segunda aba, foi feito por macro, onde a coluna H, que contem as datas acaba ficando errado

a terceira aba, é a aba feita manual,

gostaria de uma macro pra fazer igual a terceira aba,

podem me ajudar?

Apaga-linhas.xlsm

Postado : 09/09/2020 8:33 am

EdsonBR

(@edsonbr)

Posts: 1057

Noble Member

Boa tarde, amigo @fabio-cmaa

Teste o seguinte código:

Sub SintetizaPlan()
  Dim ws As Worksheet, rg As Range, i As Long, cabeçalho As Variant
  With ThisWorkbook
    .Worksheets("ORIGANAL").Copy After:=.Worksheets(.Worksheets.Count)
    Set ws = .ActiveSheet
  End With
  Set rg = Intersect(ws.Columns("A"), ws.UsedRange)
  On Error Resume Next
    rg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlUp
  On Error GoTo 0
  For i = rg.Rows.Count To 1 Step -1
    With rg.Rows(i)
      If Len(.Value) <> 284 Or Not (.Value Like (Space(21) & "######" & Space(7) & "*")) Then
        .EntireRow.Delete xlUp
      End If
    End With
  Next i
 rg.TextToColumns Destination:=ws.Range("B2"), _
                     DataType:=xlFixedWidth, TrailingMinusNumbers:=True, _
                    FieldInfo:=Array(Array(0, xlSkipColumn), _
                                     Array(17, xlGeneralFormat), _
                                     Array(27, xlSkipColumn), _
                                     Array(31, xlGeneralFormat), _
                                     Array(41, xlSkipColumn), _
                                     Array(48, xlGeneralFormat), _
                                     Array(56, xlSkipColumn), _
                                     Array(66, xlGeneralFormat), _
                                     Array(73, xlSkipColumn), _
                                     Array(83, xlTextFormat), _
                                     Array(98, xlTextFormat), _
                                    Array(109, xlSkipColumn), _
                                    Array(115, xlDMYFormat), _
                                    Array(125, xlTextFormat), _
                                    Array(139, xlGeneralFormat), _
                                    Array(153, xlGeneralFormat), _
                                    Array(169, xlGeneralFormat), _
                                    Array(185, xlGeneralFormat), _
                                    Array(205, xlGeneralFormat), _
                                    Array(224, xlGeneralFormat), _
                                    Array(243, xlGeneralFormat), _
                                    Array(264, xlGeneralFormat), _
                                    Array(284, xlSkipColumn))
 cabeçalho = Array("Nº Pesagem", "Hr.Entrada", "Hr.Saída", "Hora NF", "Nº Ord. Carreg.", "N.F.", _
                   "Dt. Movto", "Caminhão", "1º Reboque", "2º Reboque", "Peso Emb.", "Peso Tara", _
                   "Peso Bruto", "Peso Líquido", "Líquido sem Emb.", "Quantidade")
 ws.Range("B1:Q1").Value = cabeçalho
 rg.EntireColumn.Delete xlShiftToLeft
 ws.ListObjects.Add xlSrcRange, ws.Range("A1").CurrentRegion, , xlYes
 ws.Range("A1").CurrentRegion.EntireColumn.AutoFit
End Sub

Postado : 09/09/2020 3:00 pm

fabio.cmaa

(@fabio-cmaa)

Posts: 0

Estimable Member

Topic starter

@edsonbr

Boa tarde,

é isso mesmo Edson muito obrigado, porem, eu queria deixar uma planilha fixa determinada por ex,?

With ThisWorkbook

.Worksheets("ORIGANAL").Copy After:=.Worksheets("Ludimilar")

Set ws = .ActiveSheet

End With

tentei alterar a aba para Ludimila, pra sempre exportar pra ela, porem continua sempre criando uma nova aba, onde seria pra corrigir?

Postado : 09/09/2020 3:30 pm

EdsonBR

(@edsonbr)

Posts: 1057

Noble Member

Os dados brutos estarão também nessa "Ludimilar"? O que vc vai fazer se já existirem dados nessa planilha: apagar tudo ou acrescentar ao final?

Postado : 09/09/2020 4:24 pm

fabio.cmaa

(@fabio-cmaa)

Posts: 0

Estimable Member

Topic starter

@edsonbr

na planilha não irá conter nada, apenas em branco pra receber os dados da ORIGINAL

Sempre apagar tudo e adicionar novamente os novos dados...

Postado : 09/09/2020 4:55 pm

EdsonBR

(@edsonbr)

Posts: 1057

Noble Member

Veja agora, @fabio.cmaa

Sub SintetizaPlan()
  Dim ws As Worksheet, rg As Range, i As Long, cabeçalho As Variant
  Application.ScreenUpdating = False
    With ThisWorkbook
      Application.DisplayAlerts = False
        On Error Resume Next
          .Worksheets("Ludimilar").Delete
        On Error GoTo 0
      Application.DisplayAlerts = True
      .Worksheets("ORIGANAL").Copy After:=.Worksheets(.Worksheets.Count)
      Set ws = .ActiveSheet
      ws.Name = "Ludimilar"
    End With
    Set rg = Intersect(ws.Columns("A"), ws.UsedRange)
    On Error Resume Next
      rg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlUp
    On Error GoTo 0
    For i = rg.Rows.Count To 1 Step -1
      With rg.Rows(i)
        If Len(.Value) <> 284 Or Not (.Value Like (Space(21) & "######" & Space(7) & "*")) Then
          .EntireRow.Delete xlUp
        End If
      End With
    Next i
    rg.TextToColumns Destination:=ws.Range("B2"), _
                        DataType:=xlFixedWidth, TrailingMinusNumbers:=True, _
                       FieldInfo:=Array(Array(0, xlSkipColumn), _
                                       Array(17, xlGeneralFormat), _
                                       Array(27, xlSkipColumn), _
                                       Array(31, xlGeneralFormat), _
                                       Array(41, xlSkipColumn), _
                                       Array(48, xlGeneralFormat), _
                                       Array(56, xlSkipColumn), _
                                       Array(66, xlGeneralFormat), _
                                       Array(73, xlSkipColumn), _
                                       Array(83, xlTextFormat), _
                                       Array(98, xlTextFormat), _
                                      Array(109, xlSkipColumn), _
                                      Array(115, xlDMYFormat), _
                                      Array(125, xlTextFormat), _
                                      Array(139, xlGeneralFormat), _
                                      Array(153, xlGeneralFormat), _
                                      Array(169, xlGeneralFormat), _
                                      Array(185, xlGeneralFormat), _
                                      Array(205, xlGeneralFormat), _
                                      Array(224, xlGeneralFormat), _
                                      Array(243, xlGeneralFormat), _
                                      Array(264, xlGeneralFormat), _
                                      Array(284, xlSkipColumn))
    cabeçalho = Array("Nº Pesagem", "Hr.Entrada", "Hr.Saída", "Hora NF", "Nº Ord. Carreg.", "N.F.", _
                      "Dt. Movto", "Caminhão", "1º Reboque", "2º Reboque", "Peso Emb.", "Peso Tara", _
                      "Peso Bruto", "Peso Líquido", "Líquido sem Emb.", "Quantidade")
    ws.Range("B1:Q1").Value = cabeçalho
    rg.EntireColumn.Delete xlShiftToLeft
    ws.ListObjects.Add xlSrcRange, ws.Range("A1").CurrentRegion, , xlYes
    ws.Range("A1").CurrentRegion.EntireColumn.AutoFit
  Application.ScreenUpdating = True
End Sub

Postado : 09/09/2020 9:55 pm

fabio.cmaa and JSCOPA10 reacted