Посчитать количество ТОЧЕК в ячейках

[Elixi]

если сделать поправкой ваших макросов это надеюсь будет работать:
( но возникла небольшая сложность с "растягиванием" и чтобы оно работало,
как думаю должно работать, я его всунул в процедуру Sub остальныеУровни()... )

Sub ИТОГ()
    Call убратьЗнаки
    Call остальныеУровни
End Sub


Sub убратьЗнаки()
  Dim r As Long, v As String, i As Long
  For i = 11 To Cells(Rows.Count, 1).End(xlUp).Row
    v = CStr(Cells(i, 1).Value)
    If v <> "" Then
        Cells(i, 4).NumberFormat = "@"
        Cells(i, 4).Value = Left(v, Len(v) - 1)
    End If
    Next
End Sub


Sub остальныеУровни()
Dim i As Long, i2 As Long
Dim TK As Integer
Dim PP As Boolean
PP = False
    i2 = Sheets(2).Cells(Rows.Count, 2).End(xlUp).Row
    For i = 11 To Sheets(1).Cells(Rows.Count, 4).End(xlUp).Row
        TK = Len(Sheets(1).Cells(i, 4).Value) - Len(Replace(Sheets(1).Cells(i, 4).Value, ".", ""))
        Select Case TK
            Case Is = 1
                Sheets(2).Cells(i2 - 4 + i - 6, 2) = Sheets(1).Cells(i, 2).Value
            Case Is = 2
                Sheets(2).Cells(i2 - 4 + i - 6, 3) = Sheets(1).Cells(i, 2).Value
            Case Is = 3
                Sheets(2).Cells(i2 - 4 + i - 6, 4) = Sheets(1).Cells(i, 2).Value
            Case Is = 4
                Sheets(2).Cells(i2 - 4 + i - 6, 5) = Sheets(1).Cells(i, 2).Value
            Case Is = 5
                Sheets(2).Cells(i2 - 4 + i - 6, 6) = Sheets(1).Cells(i, 2).Value
            Case Is = 6
                Sheets(2).Cells(i2 - 4 + i - 6, 7) = Sheets(1).Cells(i, 2).Value
        End Select
        ' растягивание
        If PP Then
            If Sheets(2).Cells(i2 - 4 + i - 6, 2) = "" Then
                Sheets(2).Cells(i2 - 4 + i - 6, 2) = Sheets(2).Cells(i2 - 4 + i - 6 - 1, 2)
            End If
            If Sheets(2).Cells(i2 - 4 + i - 6, 3) = "" Then
                If Sheets(2).Cells(i2 - 4 + i - 6, 2) = Sheets(2).Cells(i2 - 4 + i - 6 - 1, 2) Then
                    Sheets(2).Cells(i2 - 4 + i - 6, 3) = Sheets(2).Cells(i2 - 4 + i - 6 - 1, 3)
                End If
            End If
        End If
        PP = True
    Next i
End Sub

[lilpop]

Elixi,
спасибо Вам огромное! все работает идеально!