1:

Private Sub Befehl137_Click()    Dim data(1) As Byte     data(0) = 4    data(1) = 80    MsgBox "Crc16 = " & Hex$(CRC_CCITT2(data, True)) End Sub

1:

Public Function CRC_CCITT2(btArrX() As Byte, _     bolLOFirst As Boolean) As Long     Dim lngCRC As Long     Dim lngPolynom As Long     Dim x As Long     Dim y As Long     Dim bolB1 As Boolean     Dim bolB2 As Boolean     Dim lngArr2(15) As Long     Dim lngCRC2 As Long     Dim btArr() As Byte         ReDim btArr(UBound(btArrX) + 2)      For x = 0 To UBound(btArrX)         btArr(x) = btArrX(x)     Next     btArr(x) = &H0     btArr(x + 1) = &H0      For x = 0 To 15         lngArr2(x) = 2 ^ x     Next      lngPolynom = &H8005&      For x = 0 To UBound(btArr)         For y = 0 To 7             bolB1 = lngCRC > &H7FFF&             bolB2 = btArr(x) And lngArr2(y)             lngCRC = lngCRC And &H7FFF&              lngCRC = lngCRC * 2             If bolB2 Then                 lngCRC = lngCRC + 1             End If             If bolB1 Then                 lngCRC = lngCRC Xor lngPolynom             End If         Next     Next      If bolLOFirst Then         For x = 0 To 15             If lngCRC And lngArr2(x) Then                 lngCRC2 = lngCRC2 + lngArr2(15 - x)             End If         Next         CRC_CCITT2 = lngCRC2     Else         CRC_CCITT2 = lngCRC     End If  End Function