Как да създадем стъбло‑лист диаграма в Excel 2007

Стъбло‑лист диаграмата (stem‑and‑leaf plot) е визуален инструмент за представяне на статистически данни, който запазва всяка отделна стойност. За разлика от пай диаграмите или хистограмите, където данните се групират в категории, тук можете да видите всички оригинални числа.

Подготовка на работната книга

Създаване на листове

1. Преминете в долната част на Excel и кликнете върху таба на първия лист. Преименувайте го на Data.

2. Създайте втори лист и го наречете Stem.

Въвеждане на данните

Въведете числовия списък в колона А на лист Data, по една стойност във всяка клетка.

Добавяне на VBA макрос

1. Натиснете Alt + F11, за да отворите Visual Basic Editor.

2. В лявото дърво изберете ThisWorkbook под Microsoft Excel Objects и двойно кликнете, за да се появи празен прозорец за код.

3. Копирайте и поставете следния VBA код в прозореца:

Sub StemAndLeaf()
    Dim dataColumn As Integer: dataColumn = 1
    'Изчистване на листа Stem
    Worksheets("Stem").Cells.Clear
    'Активиране на листа Data
    Worksheets("Data").Activate
    'Намиране на максималната стойност
    Dim rowPointer As Long: rowPointer = 2
    Do Until Cells(rowPointer, 1).Value = ""
        rowPointer = rowPointer + 1
    Loop
    Dim Maximum As Double: Maximum = Cells(rowPointer - 1, dataColumn).Value
    'Определяне на делителя за листата
    Dim divisor As Double: divisor = 1
    Do Until Maximum / divisor <= 10
        divisor = divisor * 10
    Loop
    'Ако първата цифра е < 5, използваме по‑голям делител
    If Fix(Maximum / divisor) < 5 Then divisor = divisor * 10
    Dim topStem As Long: topStem = Fix(Maximum / divisor)
    'Подготовка на листа Stem
    Worksheets("Stem").Activate
    Cells(1, 1).Value = "Count"
    Cells(1, 2).Value = "Stem"
    Cells(1, 3).Value = "Leaves"
    For rowPointer = 2 To topStem + 2
        Cells(rowPointer, 2).Value = rowPointer - 2
        Cells(rowPointer, 3).Value = "|"
    Next rowPointer
    'Броене на елементите за всеки стъбло
    Worksheets("Data").Activate
    rowPointer = 2
    Do Until Cells(rowPointer, dataColumn).Value = ""
        Dim measurement As Double: measurement = Cells(rowPointer, dataColumn).Value
        Dim Stem As Long: Stem = Fix(measurement / divisor)
        Worksheets("Stem").Cells(Stem + 2, 1).Value = Worksheets("Stem").Cells(Stem + 2, 1).Value + 1
        rowPointer = rowPointer + 1
    Loop
    'Определяне на фактор за съкращаване (ако има твърде много листа)
    Worksheets("Stem").Activate
    Dim maximumCount As Long: maximumCount = 0
    For rowPointer = 2 To topStem + 2
        If Cells(rowPointer, 1).Value > maximumCount Then
            maximumCount = Cells(rowPointer, 1).Value
        End If
    Next rowPointer
    Dim shrinkFactor As Long: shrinkFactor = Fix(maximumCount / 50)
    If shrinkFactor < 1 Then shrinkFactor = 1
    Cells(1, 4).Value = "Всеки знак представлява " & shrinkFactor & " случаи"
    'Попълване на листата с реалните стойности
    Worksheets("Data").Activate
    rowPointer = 2
    Do Until Cells(rowPointer, dataColumn).Value = ""
        measurement = Cells(rowPointer, dataColumn).Value
        Stem = Fix(measurement / divisor)
        Dim leaf As Long: leaf = measurement - Stem * divisor
        leaf = Fix(leaf * 10 / divisor)
        Worksheets("Stem").Cells(Stem + 2, 3).Value = Worksheets("Stem").Cells(Stem + 2, 3).Value & Trim(Str(leaf))
        rowPointer = rowPointer + shrinkFactor
    Loop
    Worksheets("Stem").Activate
End Sub

4. Натиснете F5, за да изпълните макроса. Диаграмата ще се появи в листа Stem.

Съвети

• Ако промените данните, просто стартирайте макроса отново – той ще обнови диаграмата автоматично.
• Параметърът shrinkFactor гарантира, че листата няма да станат твърде дълги; можете да го настроите ръчно, ако желаете.