[
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
[
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
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