RLE Excel 中的文本单元格数组
RLE an array of Text cells in Excel
我有一个 Excel 文件,其中包含另一个程序的输出。
它的格式为:
我想用 VBA 宏将其 RLE 编码为类似于以下的格式:
例如:
0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00 将被编码为
4,0xff,4,0x00
表示为一个单元格,第一个字符的出现次数为 0xff,直到行中的值发生变化,然后从下一个字符的重复次数开始新的计数。
有没有一种我没有看到的更简单的方法来做到这一点?
这可能会给你一些想法:
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
例如,在立即 Window:
?JoinCollection(RLE(Array("H","T","T","T","H","H","T","H","H","H","T")))
1H3T2H1T3H1T
另一种简单的方法。如图所示,这会将编码值置于数据下方 3 行。
可以根据您的要求修改代码以将输出放在另一个 sheet /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
我有一个 Excel 文件,其中包含另一个程序的输出。 它的格式为:
我想用 VBA 宏将其 RLE 编码为类似于以下的格式:
例如:
0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00 将被编码为
4,0xff,4,0x00
表示为一个单元格,第一个字符的出现次数为 0xff,直到行中的值发生变化,然后从下一个字符的重复次数开始新的计数。
有没有一种我没有看到的更简单的方法来做到这一点?
这可能会给你一些想法:
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
例如,在立即 Window:
?JoinCollection(RLE(Array("H","T","T","T","H","H","T","H","H","H","T")))
1H3T2H1T3H1T
另一种简单的方法。如图所示,这会将编码值置于数据下方 3 行。
可以根据您的要求修改代码以将输出放在另一个 sheet /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