Данные - цифры (хоть Integer), уже отсортированны, нужно в соседнем столбце их места указать.
Проблема в том что если одна цифирь равна следующей (все после сортировки) то она "делит" с ней свое место.. т. е. если исходный ряд напр. 3,4,4,4,71,83,83,97,0,0. То места распределятся должны так 1,2-4,2-4,2-4,5,6-7,6-7,8,-,- .
попытки мои, не приблизили и на половину к решению..
мне кажется все гораздо проще, а может где-то рядом..
нули в конец переместить-"попутная просьба", я сам это дело решил тем что на "-" или текст их меняю перед сортировкой.
- Код: Выделить всё
Sub Padalka()
For n = 0 To 13
For i = 0 To 13
If Cells(4 + i, 2) = Cells(4 + 1 + i, 2) Then
Cells(4 + i, 5 + n).Value = "'"&i + 1 & "-" & i + 2
Cells(4 + i + 1, 5 + n).Value = Cells(4 + i, 5 + n)
Else
Cells(4 + i, 4).Value = i + 1
End If
Next i
Next n
End Sub
ЕЩЕ вариант
Sub Padalk01()
Dim tEmp As String
For i = 0 To 13
If Cells(4 + i, 2) <> Cells(4 + 1 + i, 2) Then
Cells(4 + i, 4).Value = i + 1
Else
First = i
GoTo DoAnaser01
End If
Next i
DoAnaser01:
Cells(4 + i, 4).Value = "'" & i + 1 & "-" & i + 2
Cells(4 + i + 1, 4).Value = Cells(4 + i, 4)
For i = First To 13 - 2
If Cells(4 + i, 2) <> Cells(4 + 1 + i, 2) Then
Cells(4 + i + 2, 4).Value = i + 2 + 1
Else
Last = i
GoTo DoAnaser02
End If
Next i
DoAnaser02:
Cells(4 + i, 4).Value = "'" & i + 1 & "-" & i + 2
Cells(4 + i + 1, 4).Value = Cells(4 + i, 4)
For i = Lsst To 13 - 2
Cells(4 + i + 2, 4).Value = i + 2 + 1
Next i
End Sub
И ЕЩЕ вариант
Sub Padalk02()
Dim i As Integer
Dim tEmp(13) As Integer
For i = 0 To 13
If Cells(4 + i, 2) = Cells(4 + 1 + i, 2) Then
tEmp(1) = i
tEmp(2) = i + 1
Cells(4 + tEmp(1), 4).Value = "'" & tEmp(1) & "-" & tEmp(2)
Cells(4 + tEmp(2), 4).Value = Cells(4 + tEmp(1), 4)
Cells(tEmp(2) + i, 4).Value = tEmp(2) + i
Else
Cells(4 + i, 4).Value = i + 1
End If
Next i
End Sub
В общем гуляю я неизвестно где, может кто поможет...
