霍夫曼編碼（Huffman Coding），又譯為哈夫曼編碼、赫夫曼編碼，是一種用於無損資料壓縮 演算法。由大衛·霍夫曼在 1952 年發明。

在電腦資料處理中，霍夫曼編碼使用變長編碼表對源符號（如檔案中的一個字母）進行編碼。 例如，在英文中，e 的出現機率最高，而 z 的出現機率則最低。當利用霍夫曼編碼對一篇英文 進行壓縮時，e 極有可能用一個位元來表示，而 z 則可能花去 25 個位元（不是 26）。用普通 的表示方法時，每個英文字母均占用一個字元組，即 8 個位元。二者相比，e 使用了一般編 碼的1/8的長度， z則使用了3倍多。倘若我們能對於英文中各個字母出現機率較準確的估算， 就可以大幅度提高無失真壓縮的比例。 霍夫曼編碼（Huffman Coding）要先建立霍夫曼樹(Huffman Tree): 建立霍夫曼樹(Huffman Tree)步驟： (一) 針對相異字元, 統計其出現的次數 :

(二) 為每個字元建立一顆只有一節點的樹, 每棵樹的根節點之關鍵值(紅色字)為其字元出現的 次數. 

(三) 找出根節點關鍵值(出現次數)最小的兩顆樹。 

(四) 產生一個新的根節點，並將找到的兩棵樹分別當作此新的根節點之左右子樹(節點關鍵值 大的放左樹，關鍵值小的放右樹或是節點關鍵值小的放左樹，關鍵值大的放右樹)，而根節點 的關鍵值為左右子樹節點之關鍵值(紅色字)的和. 

(五) 重複步驟 (三) 與 (四)，直至全部節點合併為一棵樹。 

( 三) 找出根節點關鍵值(出現次數)最小的兩顆樹13,1(三) 找出根節點關鍵值(出現次數)最小的兩顆樹8,11。

(三)找出根節點關鍵值(出現次數)最小的兩顆樹19,19。 二個關鍵值一樣，可以安照排序先後秩序(三) 找出根節點關鍵值(出現次數)最小的兩顆樹28,38 

輸入說明： 第一列的數字 n 代表有幾筆資料要測試， ，第二列起為測試資料，之後每列為每組 測試資料，每組測試資料至少有2個正整數最多有26個正整數，正整數數字 ， 。 各個數字間以“,”隔開，分別代表各字元的出現的次數。每組資料都有 M 個相異數字 ( ) ，讓你去建立霍夫曼樹(Huffman Tree)。會避免 3,3,8,8 這樣輸出結果不唯一的 測試資料。

輸出說明： 在測試資料中所建建立霍夫曼樹(Huffman Tree)，完成霍夫曼編碼(Huffman Code)及計算霍夫 曼編碼(Huffman Code)位元數(長度)，這組測試資料輸出一列，各個數字間以“,”隔開，分別代 表各字元的霍夫曼編碼(Huffman Code)位元數(長度)。

輸入檔案 1：【檔名：in1.txt】
2
 2,3,6,8,13,15,19
 4,8,5

輸入檔案 2：【檔名：in2.txt】
 3
26,25,20,15,10,5
4,3,5,6
2,1

輸出範例：【檔名：out.txt】
5,5,4,3,2,2,2
2,1,2

2,2,2,3,4,4
2,2,2,2
1,1

程式碼解說:
以下為全域變數
Structure bitree   '結構
        Dim p As Integer  '樹的父
        Dim leftch As Integer'樹的左子
        Dim rightch As Integer'樹的右子
        Dim data As Integer '值
    End Structure
    Dim n = 0
    Dim a() As bitree '陣列裝樹的結構
    Dim anst = ""

Dim s = "26,25,20,15,10,5" '字元出現次數
Dim starray1 = s.Split(",")

 n = UBound(starray1)
        Dim starray(n) As Integer
        For i = 0 To n 'UBound(starray)
            starray(i) = Int(starray1(i))'換成整數
        Next
        Array.Sort(starray)'排序

Dim f = True
        ReDim a(n) 'As bitree
     
        Dim m = 0
        Dim s1 = 0
        Dim s2 = 1
排序後取最後2位放入結構陣列最小的
        While f
            If s2 <= n Then
                a(m).leftch = starray(s2) '大的放左
                a(m).rightch = starray(s1) '小的放右
                a(m).p = Int(starray(s1)) + Int(starray(s2)) '父為兩者值
                starray(s2) = Int(starray(s1)) + Int(starray(s2))放入陣列
                starray(s1) = 0'已放入結構的歸0
                Array.Sort(starray)'重新排序
                s1 += 1'往後取
                s2 += 1
                m += 1'下一個結構陣列
            Else
                f = False
            End If
        End While
跑完迴圈全部放入結構陣列了


遞迴副程式
 Sub findlayers(ByVal target, ByVal m, ByVal edge, ByVal n2) 'target 是要找的值,m 為根 n2是陣列個數
        Dim m1 = m
        Dim n1 = n2
        ' anst = edge
        If target <> m1 And n1 >= 0 Then'没找到同時没超過陣列數目
            For i = n1 To 0 Step -1'結構陣列中去找`
                If a(i).p = m Then'找到根的結構往下
             
                     If target = a(i).leftch Then
                        anst = edge & "0" '找到值了因往左所以路徑加0且停止
                    Else'没找到継續往下
                        findlayers(target, a(i).leftch, edge & "0", n1) '左子成為下一個要找根 路徑多一0
                    End If

                    If target = a(i).rightch Then'找到值了因往右所以路徑加1且停止
                        anst = edge & "1"
                    Else
                        findlayers(target, a(i).rightch, edge & "1", n1)'右子成為下一個要找根 路徑多一1
                    End If

                End If

            Next
        End If

    End Sub


 Dim root = a(n - 1).p  最上層的父為止樹的根
        Dim codest = ""
        Dim ans = ""
        Dim lengthcode = 0

        For i = 0 To n '每一數往下找
            findlayers(starray1(i), root, "", n - 1)'副程式遞迴
            codest = codest & anst & "/" 編碼(01等)
            lengthcode = Len(anst)'有幾個路徑即為位元數(長度)。
            ans = ans & lengthcode & "/"
            anst = ""

        Next
        MsgBox(codest)
        MsgBox(ans)

影音解說