Kaip sukurti stiebo ir lapo diagramą „Excel 2007“

Stiebo ir lapo diagrama (dar vadinama stemplot) – tai grafikas, skirtas statistiniams duomenims atvaizduoti, leidžiantis matyti kiekvieną atskirą duomenų tašką, ko dažnai trūksta naudojant paprastus diagramų tipus, pvz., skritulinę diagramą ar histogramą.

Paruošimas

1. Sukurkite darbalapius

Pakeiskite pirmojo tuščio darbalapio pavadinimą į Data – spustelėkite apačioje esančią kortelę ir įveskite naują pavadinimą.

Sukurkite dar vieną tuščią darbalapį ir pavadinkite jį Stem.

2. Įveskite duomenis

Įveskite skaičių sąrašą į stulpelį A darbalapyje Data.

VBA makrokomandos kūrimas

Paspauskite Alt + F11, kad atidarytumėte Visual Basic redaktorių. Kairėje panelėje du kartus spustelėkite ThisWorkbook ir įklijuokite žemiau pateiktą kodą:

Sub StemAndLeaf()
    Dim dataColumn As Integer: dataColumn = 1
    'Išvalyti darbalapį „Stem“
    Worksheets("Stem").Cells.Clear

    'Pasirinkti darbalapį „Data“
    Worksheets("Data").Activate

    'Rasti didžiausią reikšmę
    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

    'Nustatyti daliklį (divisor) lapų išskyrimui
    Dim divisor As Double: divisor = 1
    Do While Maximum / divisor > 10
        divisor = divisor * 10
    Loop
    If Fix(Maximum / divisor) < 5 Then divisor = divisor * 10

    Dim topStem As Long: topStem = Fix(Maximum / divisor)

    'Paruošti darbalapį „Stem“
    Worksheets("Stem").Activate
    Cells(1, 1).Value = "Count"
    Cells(1, 2).Value = "Stem"
    Cells(1, 3).Value = "Leaves"
    Dim i As Long
    For i = 2 To topStem + 2
        Cells(i, 2).Value = i - 2
        Cells(i, 3).Value = "|"
    Next i

    'Skaičiuoti kiekvieno stiebo pasikartojimus
    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

    'Apskaičiuoti suspaudimo koeficientą (jei reikia)
    Worksheets("Stem").Activate
    Dim maximumCount As Long: maximumCount = 0
    For i = 2 To topStem + 2
        If Cells(i, 1).Value > maximumCount Then maximumCount = Cells(i, 1).Value
    Next i
    Dim shrinkFactor As Long
    shrinkFactor = Fix(maximumCount / 50)
    If shrinkFactor < 1 Then shrinkFactor = 1
    Cells(1, 4).Value = "Kiekvienas skaitmuo reiškia " & shrinkFactor & " atvejus"

    'Užpildyti lapus
    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

3. Vykdyti makrokomandą

Grįžkite į Excel, paspauskite F5 arba pasirinkite Run meniu. Stiebo ir lapo diagrama atsiras darbalapyje Stem.

Patarimai

Jei pakeičiate duomenis, tiesiog dar kartą paleiskite makrokomandą StemAndLeaf – diagrama atsinaujins automatiškai.