RLE массив текстовых ячеек в Excel - PullRequest
0 голосов
/ 21 февраля 2019

У меня есть файл Excel, который содержит вывод из другой программы.Он имеет формат:

Section of a larger array of values

Я хотел бы RLE кодировать это с помощью макроса VBA в формат, подобный:

First 3 lines RLE encoded.

например:
0xff, 0xff, 0xff, 0xff, 0x00,0x00,0x00,0x00 будет закодировано как 4,0xff, 4,0x00 представлено как одна ячейкас числом появлений первого символа, 0xff до изменения значения в строке, затем начинается новый отсчет с количеством повторений следующих символов.

Есть ли способ сделать это проще, чего я просто не вижу?

Ответы [ 2 ]

0 голосов
/ 21 февраля 2019

Еще один простой подход.Это поместит закодированные значения на 3 строки ниже данных, как показано на рисунке.enter image description here

Может изменить код в соответствии с вашим требованием для размещения вывода на другом листе / Workbook.

Sub test()
Dim Rw As Long, Col As Long, Trw As Long, Tcol As Long, PrvVal As Variant, Val As Variant, Cnt As Long
Rw = 1
Trw = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 3  'Target row modify according to
'Trw = 20

With ActiveSheet
PrvVal = .Cells(Rw, 1).Value

Do While PrvVal <> ""
    Col = 1
    Tcol = 1
    Cnt = 0

    Do
    Val = .Cells(Rw, Col).Value
        If Val = PrvVal Then
        Cnt = Cnt + 1
        Else
        .Cells(Trw, Tcol).Value = Cnt & " " & PrvVal
        PrvVal = Val
        Cnt = 1
        Tcol = Tcol + 1
            If Val = "" Then
            Cnt = 0
            Exit Do
            End If
        End If
    Col = Col + 1
    Loop

Rw = Rw + 1
Trw = Trw + 1
PrvVal = .Cells(Rw, 1).Value
Loop
End With
End Sub
0 голосов
/ 21 февраля 2019

Это может дать вам несколько идей:

Function RLE(items As Variant) As Collection
    'Takes a 1-dimensional array of items and returns a collection
    'which consists of alternating counts and items

    Dim item As Variant, count As Long
    Dim i As Long
    Dim Col As New Collection

    item = items(LBound(items))
    count = 1
    For i = LBound(items) + 1 To UBound(items)
        If items(i) = item Then
            count = count + 1
        Else
            Col.Add count
            Col.Add item
            item = items(i)
            count = 1
        End If
    Next i
    Col.Add count
    Col.Add item
    Set RLE = Col
End Function

'for testing purposes:

Function JoinCollection(C As Collection, Optional delim As String = "") As String
    Dim A As Variant
    Dim i As Long, n As Long

    n = C.count
    ReDim A(1 To n)
    For i = 1 To n
        A(i) = C(i)
    Next i
    JoinCollection = Join(A, delim)
End Function

Например, в «Немедленном окне»:

?JoinCollection(RLE(Array("H","T","T","T","H","H","T","H","H","H","T")))
1H3T2H1T3H1T
...