0

[EJEMPLO1

hola tengo un dilema no tengo ni la mas minima idea de como hacerlo quiero quitar los repetidos pero que inserte una linea cuando se dejen de repetir

1
  • Pero ¿has probado ya algo? ¿tienes un ejemplo de eso que ya has probado? O no tienes nada y necesitas el código completo?. Te recomiendo leas esto: es.stackoverflow.com/help/how-to-ask
    – dogwall
    Commented el 26 oct. 2020 a las 7:58

1 respuesta 1

0
Sub Ordena()
Application.ScreenUpdating = False
Dim uf, uff, uff1, r1, r3, r, conta, k1, co, fila, fila2, conta1 As String
Dim x As Integer
Dim sum As Currency
'determines last row with data
uf = Sheets("NOBORRAR").Range("A" & Rows.Count).End(xlUp).Row
uc = Sheets("NOBORRAR").Cells("1," & Columns.Count).End(xlToRight).Address(False, 
False)
uc = Mid(uc, 1, 1)
r = 1
conta = 0
fila = 2
fila2 = 2
sum = 0
conta1 = 0
x = 2
'Antes de ordenar, elimina filas vacias
uff = Sheets("NOBORRAR").Range("A" & Rows.Count).End(xlUp).Row
While x <= uff
If Sheets("NOBORRAR").Cells(x, 1) = Empty Then
    Sheets("NOBORRAR").Cells(x, 1).EntireRow.Delete
    x = x - 1
GoTo aqui:
End If
x = x + 1
aqui:
uff = Sheets("NOBORRAR").Range("G" & Rows.Count).End(xlUp).Row
Wend

While Sheets("NOBORRAR").Cells(1, r) <> Empty And conta = 0
    If Sheets("NOBORRAR").Cells(1, r) = "N" Then
        k = Sheets("NOBORRAR").Cells(1, r).Address(False, False)
        co = Sheets("NOBORRAR").Cells(1, r).Column
        conta = 1
    End If
r = r + 1
Wend

k1 = Mid(k, 1, 1)

'will help determine ranges to sort data
    r1 = k & ":" & k1 & uf
    r3 = "A1:" & uc & uf
'sorts the data
    ActiveWorkbook.Worksheets("NOBORRAR").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("NOBORRAR").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("NOBORRAR").Sort
    .SetRange Range(r3)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Application.ScreenUpdating = False

While Sheets("NOBORRAR").Cells(fila, co) <> Empty
dato1 = Sheets("NOBORRAR").Cells(fila, co)

While Sheets("NOBORRAR").Cells(fila, co) <> Empty And conta1 = 0
  dato2 = Sheets("NOBORRAR").Cells(fila2, co)
  If dato1 = dato2 Then
  sum = sum + Sheets("NOBORRAR").Cells(fila2, 7).Value
  Else
   Sheets("NOBORRAR").Cells(fila2, co).EntireRow.Insert
   Sheets("NOBORRAR").Cells(fila2, co).EntireRow.Insert
   Sheets("NOBORRAR").Cells(fila2, co) = "SUMATORIA"
   Sheets("NOBORRAR").Cells(fila2, co).Select
   Selection.Font.Bold = True
   Sheets("NOBORRAR").Cells(fila2, 7) = sum
   Sheets("NOBORRAR").Cells(fila2, 7).Select
   Selection.Font.Bold = True
   Selection.Font.Bold = True
   
       With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
End With

   conta1 = 1
  End If
fila2 = fila2 + 1
Wend

fila = fila2 + 1
fila2 = fila
conta1 = 0
sum = 0
     
Wend
'Sheets("NOBORRAR").Cells(fila2, 7) = "=SUMIF(A:G,"SUMATORIA",G:G)"
   
End Sub

lo resolvi con esto

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.