Ir ao conteúdo
  • Cadastre-se

AJUSTAR RANGE na MACRO


Posts recomendados

Bom dia.

 

Preciso corrigir a macro abaixo, tornando o range ilimitado, ou melhor, fazendo com que a macro não limite o range a ser utilizado, pois sempre que preciso rodar ela tenho que definir qual a última linha que quero, e isto acaba me impedindo de tornar esta macro realmente prática.

 

Realmente agradeço a quem puder ajudar.

 

Segue:

Sub CIA_801()    ChDir "C:\users\mateus\Desktop\Eficiência de entregas"    Workbooks.OpenText Filename:= _        "C:\users\mateus\Desktop\Eficiência de entregas\801.txt", Origin:= _        xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, _        4), Array(10, 1), Array(11, 1), Array(20, 1), Array(21, 1), Array(30, 1), Array(51, 1), _        Array(52, 1), Array(55, 1), Array(56, 1), Array(58, 1), Array(59, 1), Array(84, 1), Array( _        85, 4), Array(95, 1), Array(101, 1), Array(102, 4), Array(112, 1), Array(118, 1), Array(119 _        , 1), Array(123, 1), Array(144, 1), Array(145, 4), Array(155, 1), Array(156, 1), Array(162, _        1), Array(163, 1), Array(171, 1), Array(172, 4), Array(182, 1), Array(188, 1), Array(189, 2 _        )), TrailingMinusNumbers:=True    Cells.Select    With Selection.Font        .Name = "Calibri"        .Size = 9        .Strikethrough = False        .Superscript = False        .Subscript = False        .OutlineFont = False        .Shadow = False        .Underline = xlUnderlineStyleNone        .ThemeColor = xlThemeColorLight1        .TintAndShade = 0        .ThemeFont = xlThemeFontMinor    End With    Range("A1").Select    ActiveCell.FormulaR1C1 = "Data Emissão"    Range("C1").Select    ActiveCell.FormulaR1C1 = "NF"    Range("E1").Select    ActiveCell.FormulaR1C1 = "PN"    Range("F1").Select    ActiveCell.FormulaR1C1 = "Cliente"    Range("H1").Select    ActiveCell.FormulaR1C1 = "Orig"    Range("J1").Select    ActiveCell.FormulaR1C1 = "Dest"    Range("L1").Select    ActiveCell.FormulaR1C1 = "Cidade"    Range("N1").Select    ActiveCell.FormulaR1C1 = "Data Import"    Range("Q1").Select    ActiveCell.FormulaR1C1 = "Data OC"    Range("T1").Select    ActiveCell.FormulaR1C1 = "Cód OC"    Range("U1").Select    ActiveCell.FormulaR1C1 = "Descrição da Ocorrência"    Range("W1").Select    ActiveCell.FormulaR1C1 = "Previsão Entrega"    Range("Y1").Select    ActiveCell.FormulaR1C1 = "Prazo Padrão"    Range("AA1").Select    ActiveCell.FormulaR1C1 = "Usuário"    Range("AC1").Select    ActiveCell.FormulaR1C1 = "Data Acordada"    Range("AF1").Select    ActiveCell.FormulaR1C1 = "Texto"    Range("B:B,D:D,G:G,I:I,K:K,M:M,O:O,P:P,R:R,S:S,V:V").Select    Range("V1").Activate    ActiveWindow.SmallScroll ToRight:=8    Range("B:B,D:D,G:G,I:I,K:K,M:M,O:O,P:P,R:R,S:S,V:V,X:X,Z:Z,AB:AB").Select    Range("AB1").Activate    ActiveWindow.SmallScroll ToRight:=7    Range("B:B,D:D,G:G,I:I,K:K,M:M,O:O,P:P,R:R,S:S,V:V,X:X,Z:Z,AB:AB,AD:AD,AE:AE"). _        Select    Range("AE1").Activate    Selection.Delete Shift:=xlToLeft    Columns("A:A").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("A1").Select    ActiveCell.FormulaR1C1 = "Cia"    Range("A2").Select    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[7]),RC[7],R[-1]C)"    Range("A2").Select    Selection.AutoFill Destination:=Range("A2:A65000"), Type:=xlFillDefault    Range("A2:A85000").Select    Cells.Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Range("A1").Select    Application.CutCopyMode = False    Columns("B:B").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("A1").Select    ActiveCell.FormulaR1C1 = "Dpto"    Range("B1").Select    ActiveCell.FormulaR1C1 = "Cia"    Range("B2").Select    ActiveCell.FormulaR1C1 = _        "=IF(ISNA(VLOOKUP(RC[-1],'[Eficiência de Entregas.xlsm]Dpto'!C1:C3,3,FALSE)),""?"",VLOOKUP(RC[-1],'[Eficiência de Entregas.xlsm]Dpto'!C1:C3,3,FALSE))"    Range("B2").Select    Selection.AutoFill Destination:=Range("B2:B85000"), Type:=xlFillDefault    Range("B2:B85000").Select    Columns("C:C").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("C1").Select    ActiveCell.FormulaR1C1 = "NF"    Range("C2").Select    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[2]),RC[2],R[-1]C)"    Range("C2").Select    Selection.AutoFill Destination:=Range("C2:C85000"), Type:=xlFillDefault    Range("C2:C85000").Select    Columns("A:A").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("A1").Select    ActiveCell.FormulaR1C1 = "Linha"    Range("A2").Select    ActiveCell.FormulaR1C1 = "1"    Range("A3").Select    ActiveCell.FormulaR1C1 = "2"    Range("A2:A3").Select    Selection.AutoFill Destination:=Range("A2:A85000"), Type:=xlFillDefault    Range("A2:A85000").Select    Columns("B:B").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("B1").Select    ActiveCell.FormulaR1C1 = "Linha Real"    Range("B2").Select    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[5]),RC[-1],9999999999)"    Range("B2").Select    Selection.AutoFill Destination:=Range("B2:B85000"), Type:=xlFillDefault    Range("B2:B85000").Select    Cells.Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Application.CutCopyMode = False    Range("A1").Select    Columns("F:F").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("F1").Select    ActiveCell.FormulaR1C1 = "Emissão"    Range("F2").Select    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],R[-1]C)"    Range("F2").Select    Selection.AutoFill Destination:=Range("F2:F85000"), Type:=xlFillDefault    Range("F2:F85000").Select    Columns("F:F").Select    Selection.NumberFormat = "dd/mm/yy;@"    Columns("A:F").Select    Range("F1").Activate    With Selection.Interior        .Pattern = xlSolid        .PatternColorIndex = xlAutomatic        .Color = 65535        .TintAndShade = 0        .PatternTintAndShade = 0    End With    Columns("S:S").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("S1").Select    ActiveCell.FormulaR1C1 = "Previsão Entrega"    Range("S2").Select    ActiveCell.FormulaR1C1 = _        "=IF(ISNUMBER(RC[-1]),WORKDAY(RC[-13],RC[1],'[Eficiência de Entregas.xlsm]Feriados'!R2C1:R85000C1),"""")"    Range("S2").Select    Selection.AutoFill Destination:=Range("S2:S85000"), Type:=xlFillDefault    Range("S2:S85000").Select    Selection.NumberFormat = "dd/mm/yy;@"    Cells.Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Application.CutCopyMode = False    Columns("R:R").Select    Selection.Delete Shift:=xlToLeft    Range("R1").Select    Columns("F:F").Select    Selection.Cut    Columns("E:E").Select    Selection.Insert Shift:=xlToRight    Columns("G:G").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("G1").Select    ActiveCell.FormulaR1C1 = "PN"    Range("H1").Select    ActiveCell.FormulaR1C1 = "Cliente"    Range("I1").Select    ActiveCell.FormulaR1C1 = "Orig"    Range("J1").Select    ActiveCell.FormulaR1C1 = "Dest"    Range("K1").Select    ActiveCell.FormulaR1C1 = "Cidade"    Range("G2").Select    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[5]),RC[7],R[-1]C)"    Range("H2").Select    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[4]),RC[7],R[-1]C)"    Range("I2").Select    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[3]),RC[7],R[-1]C)"    Range("J2").Select    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[2]),RC[7],R[-1]C)"    Range("K2").Select    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),PROPER(RC[7]),R[-1]C)"    Range("G2:K2").Select    Selection.AutoFill Destination:=Range("G2:K85000"), Type:=xlFillDefault    Range("G2:K85000").Select    Columns("A:K").Select    Range("K1").Activate    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Range("K1").Select    Application.CutCopyMode = False    Columns("W:W").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("W1").Select    ActiveCell.FormulaR1C1 = "Descrição da Ocorrência"    Range("W2").Select    ActiveCell.FormulaR1C1 = _        "=IF(ISNUMBER(RC[-2]),VLOOKUP(RC[-2],'[Eficiência de Entregas.xlsm]OCs'!C1:C2,2,FALSE),"""")"    Range("W2").Select    Selection.AutoFill Destination:=Range("W2:W85000"), Type:=xlFillDefault    Range("W2:W85000").Select    Columns("W:W").Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Columns("V:V").Select    Application.CutCopyMode = False    Selection.Delete Shift:=xlToLeft    Range("V1").Select    Columns("W:W").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("W1").Select    ActiveCell.FormulaR1C1 = "Finaliza Entrega"    Range("W2").Select    ActiveCell.FormulaR1C1 = _        "=IF(ISNUMBER(RC[-2]),VLOOKUP(RC[-2],'[Eficiência de Entregas.xlsm]OCs'!C1:C4,4,FALSE),"""")"    Range("W2").Select    Selection.AutoFill Destination:=Range("W2:W85000"), Type:=xlFillDefault    Range("W2:W85000").Select    Columns("W:W").Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Range("W1").Select    Columns("W:W").EntireColumn.AutoFit    Application.CutCopyMode = False    Columns("X:X").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("X1").Select    ActiveCell.FormulaR1C1 = "Abona Atraso"    Range("X2").Select    ActiveCell.FormulaR1C1 = _        "=IF(ISNUMBER(RC[-3]),IF(RC[-5]<=RC[1],VLOOKUP(RC[-3],'[Eficiência de Entregas.xlsm]OCs'!C1:C4,3,FALSE),""Não""),"""")"    Range("X2").Select    Selection.AutoFill Destination:=Range("X2:X85000"), Type:=xlFillDefault    Range("X2:X85000").Select    Columns("X:X").Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Application.CutCopyMode = False    Range("X1").Select    Columns("D:D").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("D1").Select    ActiveCell.FormulaR1C1 = "Cia+NF"    Range("D2").Select    ActiveCell.FormulaR1C1 = "=RC[1]&""-""&RC[3]"    Range("D2").Select    Selection.AutoFill Destination:=Range("D2:D85000"), Type:=xlFillDefault    Range("D2:D85000").Select    Columns("D:D").Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    ActiveWindow.SmallScroll ToRight:=3    Columns("AD:AD").Select    Application.CutCopyMode = False    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("AD1").Select    ActiveCell.FormulaR1C1 = "Texto"    Range("AD2").Select    ActiveCell.FormulaR1C1 = "=IF(R[-1]C[-26]=RC[-26],R[-1]C&"" ""&RC[1],RC[1])"    Range("AD2").Select    Selection.AutoFill Destination:=Range("AD2:AD85000"), Type:=xlFillDefault    Range("AD2:AD85000").Select    Columns("AD:AD").Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Columns("AD:AD").Select    Application.CutCopyMode = False    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("AD1").Select    ActiveCell.FormulaR1C1 = "Fim"    Range("AD2").Select    ActiveCell.FormulaR1C1 = "=IF(R[1]C[-26]<>RC[-26],""Fim do Texto"","""")"    Range("AD2").Select    Selection.AutoFill Destination:=Range("AD2:AD85000"), Type:=xlFillDefault    Range("AD2:AD85000").Select    Columns("AD:AD").Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Range("AD1").Select    Columns("E:E").Select    Application.CutCopyMode = False    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("E1").Select    ActiveCell.FormulaR1C1 = "Cia+NF+Fim do Texto"    Range("E2").Select    ActiveCell.FormulaR1C1 = _        "=IF(RC[26]=""Fim do Texto"",RC[-1]&""-""&RC[26],"""")"    Range("E2").Select    Selection.AutoFill Destination:=Range("E2:E85000"), Type:=xlFillDefault    Range("E2:E85000").Select    Columns("E:E").Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Range("E1").Select    ActiveWindow.SmallScroll ToRight:=12    Range("AE1").Select    Application.CutCopyMode = False    Columns("AF:AF").Select    Selection.Replace What:= _        "---------------------------------------------------  --------------------------------------------------- Texto ---------------------------------------------------" _        , Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _        False, SearchFormat:=False, ReplaceFormat:=False    Selection.Replace What:="   ", Replacement:=" ", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:="   ", Replacement:=" ", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:="   ", Replacement:=" ", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:="   ", Replacement:=" ", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Columns("AF:AF").Select    Range("AF16").Activate    Selection.Replace What:= _        "--------------------------------------------------- ---------------------------------------------------" _        , Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _        False, SearchFormat:=False, ReplaceFormat:=False    Selection.Replace What:="---------------------------------------------------" _        , Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _        False, SearchFormat:=False, ReplaceFormat:=False    Columns("AF:AF").Select    Selection.Replace What:="0  Texto", Replacement:="", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:="  Texto", Replacement:="", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Columns("AF:AF").Select    Selection.Replace What:="  ", Replacement:="", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:="  ", Replacement:="", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:="  ", Replacement:="", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:="  ", Replacement:="", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:="  ", Replacement:="", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Range("AF1").Select'EXCLUSÃO DAS COLUNAS FINAIS    Columns("AC:AC").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("AC1").Select    ActiveCell.FormulaR1C1 = "Texto"    Range("AC2").Select    ActiveCell.FormulaR1C1 = _        "=IF(RC[-5]=""OCORRENCIA MANUAL"",IF(IF(ISNA(VLOOKUP(RC[-25]&""-Fim do Texto"",C[-24]:C[4],29,FALSE)),"""",VLOOKUP(RC[-25]&""-Fim do Texto"",C[-24]:C[4],29,FALSE))=0,"""",IF(ISNA(VLOOKUP(RC[-25]&""-Fim do Texto"",C[-24]:C[4],29,FALSE)),"""",VLOOKUP(RC[-25]&""-Fim do Texto"",C[-24]:C[4],29,FALSE))),"""")"    Range("AC2").Select    Selection.AutoFill Destination:=Range("AC2:AC85000"), Type:=xlFillDefault    Range("AC2:AC85000").Select    Columns("AC:AC").Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Cells.Select    Range("M1").Activate    Application.CutCopyMode = False    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Range("AD1").Select    Application.CutCopyMode = False    Columns("AD:AK").Select    Selection.Delete Shift:=xlToLeft    Range("AC1").Select' CHECA SE FINALIZA ENTREGA/ABONA ATRASO?    Columns("G:G").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("G1").Select    ActiveCell.FormulaR1C1 = "Cia+NF+Entregue?"    Range("G2").Select    ActiveCell.FormulaR1C1 = "=IF(RC[19]=""Sim"",RC[-3]&""-""&RC[19],"""")"    Range("G2").Select    Selection.AutoFill Destination:=Range("G2:G85000"), Type:=xlFillDefault    Range("G2:G85000").Select    Columns("G:G").Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Application.CutCopyMode = False    Columns("H:H").Select    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    Range("H1").Select    ActiveCell.FormulaR1C1 = "Cia+NF+Abona?"    Range("H2").Select    ActiveCell.FormulaR1C1 = "=IF(RC[20]=""Sim"",RC[-4]&""-""&RC[20],"""")"    Range("H2").Select    Selection.AutoFill Destination:=Range("H2:H85000"), Type:=xlFillDefault    Range("H2:H85000").Select    Columns("H:H").Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Range("H1").Select    Application.CutCopyMode = False'EXCLUSÃO DE DADOS    Columns("P:V").Select    Selection.Delete Shift:=xlToLeft    Columns("I:O").Select    With Selection.Interior        .Pattern = xlNone        .TintAndShade = 0        .PatternTintAndShade = 0    End With    ActiveWindow.ScrollColumn = 2    ActiveWindow.ScrollColumn = 1    Range("A1:X1").Select    With Selection.Interior        .PatternColorIndex = xlAutomatic        .ThemeColor = xlThemeColorDark1        .TintAndShade = -0.149998474074526        .PatternTintAndShade = 0    End With    Range("I1").Select'REFAZER CHAVE DE BUSCA P/TEXTOS    Range("E2").Select    ActiveCell.FormulaR1C1 = _        "=IF(RC[14]=""OCORRENCIA MANUAL"",RC[-1]&""-Texto"","""")"    Range("E2").Select    Selection.AutoFill Destination:=Range("E2:E85000"), Type:=xlFillDefault    Range("E2:E85000").Select    Columns("E:E").Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Range("E1").Select    Application.CutCopyMode = False    Range("E1").Select    ActiveCell.FormulaR1C1 = "Cia+NF+Texto"'FILTRO AVANÇADO E FORMATAÇÃO    Columns("A:X").Select    Range("A1:X85000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _        Workbooks("Eficiência de Entregas.xlsm").Sheets("Filtro").Range("A1:A2"), _        CopyToRange:=Range("AA1"), Unique:=True    Columns("A:Z").Select    Selection.Delete Shift:=xlToLeft    Columns("A:H").Select    With Selection        .HorizontalAlignment = xlLeft        .VerticalAlignment = xlBottom        .WrapText = False        .Orientation = 0        .AddIndent = False        .IndentLevel = 0        .ShrinkToFit = False        .ReadingOrder = xlContext        .MergeCells = False    End With    Range("I:I,P:P,Q:Q").Select    Range("Q1").Activate    Range("I:I,P:P,Q:Q,V:V").Select    Range("V1").Activate    Selection.NumberFormat = "dd/mm/yy;@"    With Selection        .HorizontalAlignment = xlCenter        .VerticalAlignment = xlBottom        .WrapText = False        .Orientation = 0        .AddIndent = False        .IndentLevel = 0        .ShrinkToFit = False        .ReadingOrder = xlContext        .MergeCells = False    End With    Cells.Select    Range("H1").Activate    With Selection        .VerticalAlignment = xlCenter        .WrapText = False        .Orientation = 0        .AddIndent = False        .IndentLevel = 0        .ShrinkToFit = False        .ReadingOrder = xlContext        .MergeCells = False    End With    Range("J:L,X:X,S:S,O:O").Select    Range("O1").Activate    With Selection        .HorizontalAlignment = xlLeft        .VerticalAlignment = xlCenter        .WrapText = False        .Orientation = 0        .AddIndent = False        .IndentLevel = 0        .ShrinkToFit = False        .ReadingOrder = xlContext        .MergeCells = False    End With    Range("M:N,P:Q,T:U").Select    Range("T1").Activate    With Selection        .HorizontalAlignment = xlCenter        .VerticalAlignment = xlCenter        .WrapText = False        .Orientation = 0        .AddIndent = False        .IndentLevel = 0        .ShrinkToFit = False        .ReadingOrder = xlContext        .MergeCells = False    End With    Columns("W:W").Select    With Selection        .HorizontalAlignment = xlLeft        .VerticalAlignment = xlCenter        .WrapText = False        .Orientation = 0        .AddIndent = False        .IndentLevel = 0        .ShrinkToFit = False        .ReadingOrder = xlContext        .MergeCells = False    End With    With Selection        .HorizontalAlignment = xlCenter        .VerticalAlignment = xlCenter        .WrapText = False        .Orientation = 0        .AddIndent = False        .IndentLevel = 0        .ShrinkToFit = False        .ReadingOrder = xlContext        .MergeCells = False    End With    Rows("1:1").Select    Range("H1").Activate    With Selection        .VerticalAlignment = xlCenter        .WrapText = True        .Orientation = 0        .AddIndent = False        .ShrinkToFit = False        .ReadingOrder = xlContext        .MergeCells = False    End With    Selection.RowHeight = 27.5    Columns("A:X").Select    Range("X1").Activate    Columns("A:X").EntireColumn.AutoFit    Range("L1").Select    Columns("O:O").ColumnWidth = 12    Columns("S:S").ColumnWidth = 20    Columns("X:X").Select    Selection.ColumnWidth = 25    Selection.ColumnWidth = 45    Range("X1").Select    Range("A2").Select    ActiveWindow.FreezePanes = True    ActiveWindow.DisplayGridlines = False    Application.PrintCommunication = False    With ActiveSheet.PageSetup        .PrintTitleRows = "$1:$1"        .PrintTitleColumns = ""    End With    Application.PrintCommunication = True    ActiveSheet.PageSetup.PrintArea = "$I$1:$X$888888"    Application.PrintCommunication = False    With ActiveSheet.PageSetup        .LeftHeader = ""        .CenterHeader = ""        .RightHeader = ""        .LeftFooter = ""        .CenterFooter = ""        .RightFooter = ""        .LeftMargin = Application.InchesToPoints(0.393700787401575)        .RightMargin = Application.InchesToPoints(0.393700787401575)        .TopMargin = Application.InchesToPoints(0.393700787401575)        .BottomMargin = Application.InchesToPoints(0.393700787401575)        .HeaderMargin = Application.InchesToPoints(0.393700787401575)        .FooterMargin = Application.InchesToPoints(0.393700787401575)        .PrintHeadings = False        .PrintGridlines = False        .PrintComments = xlPrintNoComments        .PrintQuality = 600        .CenterHorizontally = True        .CenterVertically = False        .Orientation = xlLandscape        .Draft = False        .PaperSize = xlPaperA4        .FirstPageNumber = xlAutomatic        .Order = xlDownThenOver        .BlackAndWhite = False        .Zoom = False        .FitToPagesWide = 1        .FitToPagesTall = 18888        .PrintErrors = xlPrintErrorsDisplayed        .OddAndEvenPagesHeaderFooter = False        .DifferentFirstPageHeaderFooter = False        .ScaleWithDocHeaderFooter = True        .AlignMarginsHeaderFooter = True        .EvenPage.LeftHeader.Text = ""        .EvenPage.CenterHeader.Text = ""        .EvenPage.RightHeader.Text = ""        .EvenPage.LeftFooter.Text = ""        .EvenPage.CenterFooter.Text = ""        .EvenPage.RightFooter.Text = ""        .FirstPage.LeftHeader.Text = ""        .FirstPage.CenterHeader.Text = ""        .FirstPage.RightHeader.Text = ""        .FirstPage.LeftFooter.Text = ""        .FirstPage.CenterFooter.Text = ""        .FirstPage.RightFooter.Text = ""    End With    Application.PrintCommunication = True    Range("I2").Select    Columns("A:H").Select    Selection.EntireColumn.Hidden = True    Range("I1").Select'GERAR A ABA GERENCIAL    Sheets("801").Select    Sheets("801").Name = "801-COMPLETO"    Sheets("801-COMPLETO").Select    Sheets("801-COMPLETO").Copy Before:=Sheets(1)    Sheets("801-COMPLETO (2)").Select    Sheets("801-COMPLETO (2)").Move After:=Sheets(2)    Sheets("801-COMPLETO (2)").Select    Sheets("801-COMPLETO (2)").Name = "801-GERENCIAL"    Cells.Select    Selection.EntireColumn.Hidden = False    Columns("A:X").Select    ActiveSheet.Range("$A$1:$X$85000").RemoveDuplicates Columns:=4, Header:= _        xlYes    Columns("A:C").Select    Selection.Delete Shift:=xlToLeft    Columns("B:E").Select    Selection.Delete Shift:=xlToLeft    Range("A1").Select'FAZE FINAL DA ABA GERENCIAL    Range("I1").Select    ActiveCell.FormulaR1C1 = "Data Entrega"    Range("I2").Select    ActiveCell.FormulaR1C1 = _        "=IF(ISNA(VLOOKUP(RC[-8]&""-Sim"",'801-COMPLETO'!C[-2]:C[8],11,FALSE)),""Pendente"",VLOOKUP(RC[-8]&""-Sim"",'801-COMPLETO'!C[-2]:C[8],11,FALSE))"    Range("I2").Select    Selection.AutoFill Destination:=Range("I2:I85000"), Type:=xlFillDefault    Range("I2:I85000").Select    Columns("I:I").Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Range("J1").Select    Application.CutCopyMode = False    ActiveCell.FormulaR1C1 = "Abona Atraso?"    Range("J2").Select    ActiveCell.FormulaR1C1 = _        "=IF(ISNA(VLOOKUP(RC[-9]&""-Sim"",'801-COMPLETO'!C[-2]:C[7],10,FALSE)),""Não"",""Sim"")"    Range("J2").Select    Selection.AutoFill Destination:=Range("J2:J85000"), Type:=xlFillDefault    Range("J2:J85000").Select    Range("K1").Select    ActiveCell.FormulaR1C1 = "Data do Abono"    Range("K2").Select    ActiveCell.FormulaR1C1 = _        "=IF(ISNA(VLOOKUP(RC[-10]&""-Sim"",'801-COMPLETO'!C[-3]:C[6],10,FALSE)),""n/a"",VLOOKUP(RC[-10]&""-Sim"",'801-COMPLETO'!C[-3]:C[6],10,FALSE))"    Range("K2").Select    Selection.AutoFill Destination:=Range("K2:K85000"), Type:=xlFillDefault    Range("K2:K85000").Select    Columns("I:K").Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Columns("L:N").Select    Application.CutCopyMode = False    Selection.Delete Shift:=xlToLeft    Range("N2").Select    ActiveCell.FormulaR1C1 = _        "=IF(ISNA(VLOOKUP(RC[-13]&""-Texto"",'801-COMPLETO'!C[-9]:C[10],20,FALSE)),"""",VLOOKUP(RC[-13]&""-Texto"",'801-COMPLETO'!C[-9]:C[10],20,FALSE))"    Range("N2").Select    Selection.AutoFill Destination:=Range("N2:N85000"), Type:=xlFillDefault    Range("N2:N85000").Select    Cells.Select    Selection.Copy    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Columns("A:A").Select    Application.CutCopyMode = False    Selection.Delete Shift:=xlToLeft    Range("A1").Select'EXCLUSÃO FINAL    Columns("H:K").Select    Selection.ColumnWidth = 8    Selection.NumberFormat = "dd/mm/yy;@"    With Selection        .HorizontalAlignment = xlGeneral        .Orientation = 0        .AddIndent = False        .IndentLevel = 0        .ShrinkToFit = False        .ReadingOrder = xlContext        .MergeCells = False    End With    With Selection        .HorizontalAlignment = xlCenter        .Orientation = 0        .AddIndent = False        .IndentLevel = 0        .ShrinkToFit = False        .ReadingOrder = xlContext        .MergeCells = False    End With    Columns("A:M").Select    Range("A1:M85000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _        Workbooks("Eficiência de Entregas.xlsm").Sheets("Filtro").Range("B1:B2"), _        CopyToRange:=Range("Z1"), Unique:=False    Columns("A:M").Select    Selection.Copy    Columns("Z:AL").Select    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _        SkipBlanks:=False, Transpose:=False    Application.CutCopyMode = False    Columns("A:Y").Select    Selection.Delete Shift:=xlToLeft    Range("A1").SelectEnd Sub

Abraço

Link para o comentário
Compartilhar em outros sites

Bom dia.

 

Obrigado pelo retorno.

 

Segue em anexo o arquivo txt e o resultado da macro em Excel.

 

Cada CIA representa um CNPJ de faturamento, sendo assim preciso extrair um txt para cada, e o número de linhas depende do volume de faturamento.

 

Na CIA801, geralmente o txt retorna em torno de 15000 linhas, porém tenho outras CIAD que geram até 100.000 linhas.

 

Para não ficar ajustando manualmente e perdendo tempo, seria ótimo se a macro fosse realmente mais enxuta e identificasse sozinho a quantidade de linhas que serão utilizadas.

 

Desde já agradeço, espero que consigam me ajudar.

801.txt

801.rar

Link para o comentário
Compartilhar em outros sites

Márcio, o formato da planilha anexa será sempre o mesmo, pois ele é a base para outros relatórios da empresa.

 

Na verdade, eu preciso de todos os dados da planilha, até a coluna Z, mas eles não mudam de posição nunca.

 

Se precisares de mais alguma informação, é só pedir.

 

Obrigado.

Link para o comentário
Compartilhar em outros sites

Olá mateusmarona

 

Tentando usar o arquivo texto para importá-lo para o Excel encontrei casos em que existe um linha em branco (no arquivo texto) e isto dificulta o algorítimo de importação. Exemplos:

Nas notas 4658 e 4677 existe uma linha em branco com 17/11/2014 no campo TEXTO

Entre as notas 4606 e 4607 existem duas linha em branco

 

É possivel geral um arquivo texto sem estes tipos de casos?

 

Aguardo retorno

 

Márcio

Link para o comentário
Compartilhar em outros sites

mateusmarona, penso q o seu arquivo texto seria muito melhor gerenciado pelo Access, inclusive sem utilização de qq macro.

Uma vez o arquivo tendo sido filtrado no Access você pode facilmente importar p/ o Excel.

 

Como fazer:

  • Pelo Access você pode importar praticamente qq volume de dados em arquivo texto, desta forma acione a ferramente de importação de arquivo texto do Access em Dados Externos, escolha Delimitado, avance e escolha Outro, no caso inclua "|" como separador, avance mais duas vezes e selecione 'Sem chave pra mimária', clique concluir e salve as etapas de importação.
  • Abra a tabela no Access, a tabela deverá conter 14 campos q no primeiro momento não deverão estar corretamente nomeados, nomeie corretamente os campos prestando atenção q no arquivo texto a coluna DESTINO se refere tanto ao estado quanto a cidade e o Access separou os dois.
  • Tendo nomeado corretamente os campos você pode introduzir um filtro simples na coluna 'NF' excluindo espaços em branco e a denominação "NF".
  • Basicamente é isso!
  • Se você quiser sofisticar um pouco mais você pode criar uma consulta com o filtro na coluna 'NF' como eu fiz no arquivo anexado. <>"" & "NF"

Sem mistério, sem complicadas macros, tudo muito simples.

 

Tb é possível importar de forma semelhante pelo Excel, apenas o limite do Access é superior.

801.zip

801Excel.xlsx

Link para o comentário
Compartilhar em outros sites

Boa tarde, Basole.

 

O número grifado em vermelho é o número de linhas do TXT, e ele aparece várias vezes na macro, tanto que quando quero rodá-la eu substituo todos os números que determinam o máximo de linhas por um maior ou menor, dependendo do arquivo gerado.

 

O que eu precisava é que a macro rodasse e fizesse todas suas ações, porém sem limitar o range, de maneira a macro poder identifica sozinha o número máximo de linhas, tornando ela automática.

 

E eu não posso rodar ela no Access porque toda a empresa utiliza este relatório e eu não posso mudar seu formato, eu apenas quero um meio de torná-la mais inteligente e fluida.

Link para o comentário
Compartilhar em outros sites

E eu não posso rodar ela no Access porque toda a empresa utiliza este relatório e eu não posso mudar seu formato, eu apenas quero um meio de torná-la mais inteligente e fluida.

Se você importa um arquivo isso não afeta a fonte original, e depois de trabalhado no Access você pode exportar p/ o formato de arquivo q você quiser.

Não sei se você reparou, mas tb apontei p/ uma solução de importação utilizando o Excel somente.

Link para o comentário
Compartilhar em outros sites

 

Boa tarde, Basole.

 

O número grifado em vermelho é o número de linhas do TXT, e ele aparece várias vezes na macro, tanto que quando quero rodá-la eu substituo todos os números que determinam o máximo de linhas por um maior ou menor, dependendo do arquivo gerado.

 

O que eu precisava é que a macro rodasse e fizesse todas suas ações, porém sem limitar o range, de maneira a macro poder identifica sozinha o número máximo de linhas, tornando ela automática.

Mateus, consegu rodar, pelo menos um trecho do seu codigo, e a macro inseri (antes das formatacoes) os dados importados na coluna "B" .

então fiz uma sugestao que verifica e define a quantidade de linhas do txt.:

 

'---------------------------------------------------------

Dim UltimaLinhaB As Long

UltimaLinhaB = Cells(Rows.Count, "b").End(xlUp).Row

'--------------------------------------------------------------

Selection.AutoFill Destination:=Range("A2:A" & UltimaLinhaB), Type:=xlFillDefault 

 

Esse é um trecho do codigo que postou e a ultima linha é exatamente a linha que voce destacou, veja se consegue entender pra inserir no seu codigo original. 

qq. coisa deee um help.

 

abx. 

Link para o comentário
Compartilhar em outros sites

Márcio, boa tarde.

 

Serve sim, importou direitinho, porém gostaria que verificasse a possibilidade de adicionar uma informação que consta nos arquivos txt, porém não foram consideradas.

 

A coluna CIA representa cada unidade de faturamento da empresa, sendo assim, cada arquivo importado tem uma CIA específica para as notas fiscais.

 

que o arquivo txt tem uma informação bem no início, que é a Companhia.

 

Seria importante que a macro considerasse este dado para cada txt importado.

 

Ou seja, se em um dos arquivos tiver a Companhia 807, a coluna C da aba Importação deve preencher todas as notas com este dado.

 

Desde já agradeço muito pelo help, tá ficando show...


Márcio, um detalhe.

 

Ao rodar um txt com número alto de linhas, 150.000, a macro deu erro.

 

Veja se consegue descobrir do que se trata.

post-654793-0-30036200-1423849072_thumb.

808.rar

Link para o comentário
Compartilhar em outros sites

Mistérioooooooo.....

 

Aqui se rodo a antiga da o erro que você já mencionou. Veja no arquivo se importou as notas;

"08/12/2014|    70266|C01004762 SUPERMERCADOS BELTRA|RS |RS|Santa Maria              |                |16/12/2014 14:20|

"08/12/2014|    70286|C01004762 SUPERMERCADOS BELTRA|RS |RS|Santa Maria              |                |16/12/2014 14:19|

"30/10/2014|    68606|C00056970 ATACADAO S/A.       |RS |MS|Dourados                 |                |17/11/2014 11:13|

 

Deve ser as que estão faltando e começam com as ASPAS....

 

Márcio

Link para o comentário
Compartilhar em outros sites

Olá mateusmarona

 

Infelizmente a telas que você manda não estão ajudando.

você precisa fazer o comparativo.Siga o exemplo da planilha Resumo X 801-COMPLETO. Cole os dados da 1ª importação na planilha Resumo e o da 2ª na planilha 801-COMPLETO... E então analise o resultado da planilha Resumo X 801-COMPLETO.

 

Márcio

Link para o comentário
Compartilhar em outros sites

Visitante
Este tópico está impedido de receber novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...