人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excelで質問致します。

非常に長い文字列がA列のセルに入っています。例えば
edcbabcde0x00000y0fffffffff000000000000000000000000000FFFFFFFFF0X00000Y0EDCBABCDE00000000000000
を連続する文字列の箇所に着目し、
edcbabcde0x05y0f9027F90X05Y0EDCBABCDE014
等にしてB列のセルに表示します。圧縮したいわけです。

上手くユーザ定義関数など使うとできるでしょうか。
圧縮関数:A列からB列
解凍関数:B列からA列
の2つを作成できればよいのですが、力及ばず質問致します。

圧縮前の文字列の特性は以下の通り。
・95桁固定
・半角数字は0?9まで10種
※0以外が使われるのは後ろから14桁の部分のみ。前から81桁で使われるのは0のみ。
・半角英字は以下28種
ABCDEFXYRSTUVW
abcdefxyrstuvw

もっと圧縮率が高く、また解凍もできる関数が可能であれば、
私が示した圧縮例と異なる内容の関数でも構いません。

どうぞ宜しくお願い致します。


●質問者: yoshifuku
●カテゴリ:コンピュータ
✍キーワード:28 Excel セル ユーザ 作成
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● TransFreeBSD
●200ポイント

とりあえずベタな感じで作ってみました。

compress95/decompress95は質問にあるやり方を基本に、compress01/decompress01はid:takntさんの二進数変換によるもの。

compress95/decompress95は95文字以外は受け付けず、質問にあるのを前提にしています。compress01/decompress01は長さ、文字種に制限はありません。


Function compress95(src As String) As String
 If Len(src) <> 95 Then
 compress95 = Null
 Exit Function
 End If
 Dim result As String
 result = Replace(Left(src, 81), "0", "O")
 Set re = CreateObject("VBScript.RegExp")
 re.Global = True
 re.Pattern = "([A-FR-YO])\1+"
 For Each m In re.Execute(result)
 re.Global = False
 re.Pattern = m.Value
 result = re.Replace(result, Left(m.Value, 1) & m.Length)
 Next
 compress95 = result & Right(src, 14)
End Function

Function decompress95(src As String) As String
 Dim result As String
 result = Left(src, Len(src) - 14)
 Set re = CreateObject("VBScript.RegExp")
 re.Global = True
 re.Pattern = "[A-FR-YO][0-9]+"
 For Each m In re.Execute(result)
 re.Global = False
 re.Pattern = m.Value
 Dim s As String
 s = ""
 For i = 1 To Str(Right(m.Value, m.Length - 1))
 s = s & Left(m.Value, 1)
 Next
 result = re.Replace(result, s)
 Next
 result = Replace(result, "O", "0")
 decompress95 = result & Right(src, 14)
End Function

Function compress01(src As String) As String
 Dim result As String
 result = ""
 For i = Len(src) To 1 Step -1
 Dim c As Integer
 c = Asc(Mid(src, i, 1))
 For j = 1 To 8
 If c Mod 2 = 1 Then
 result = "X" & result
 Else
 result = "O" & result
 End If
 c = c \ 2
 Next
 Next
 Set re = CreateObject("VBScript.RegExp")
 re.Global = True
 re.Pattern = "([XO])\1+"
 For Each m In re.Execute(result)
 re.Global = False
 re.Pattern = m.Value
 result = re.Replace(result, Left(m.Value, 1) & m.Length)
 Next
 compress01 = result
End Function

Function decompress01(src As String) As String
 Dim result As String
 result = src
 Set re = CreateObject("VBScript.RegExp")
 re.Global = True
 re.Pattern = "[XO][0-9]+"
 For Each m In re.Execute(result)
 re.Global = False
 re.Pattern = m.Value
 Dim s As String
 s = ""
 For i = 1 To Str(Right(m.Value, m.Length - 1))
 s = s & Left(m.Value, 1)
 Next
 result = re.Replace(result, s)
 Next
 src = result
 result = ""
 Do While Len(src) > 0
 Dim c As Integer
 c = 0
 For j = 1 To 8
 c = c * 2
 If Left(src, 1) = "X" Then
 c = c + 1
 End If
 src = Right(src, Len(src) - 1)
 Next
 result = result & Chr(c)
 Loop
 decompress01 = result
End Function

compress95/decompress95においては終わり14文字は無制限に圧縮対象から外しています。

それ以外の部分では数字があるとまずいので0をOに変換しています。

#数字があるとまずい->たとえば"xx0"も"xx..(20文字)x"も"x20"になるため


[追記]二進数変換のがあまりにあれなので改良してみたのですが(一応載せておきます)、結局最初のが一番短くなりました。

たぶん小手先で色々やるよりdeflateとかgzipとかで圧縮するのが一番だと思いますが、excelからの利用方法が分かりませんでした。

Function compress5(src As String) As String
 Dim result As String
 result = ""
 For i = Len(src) To 1 Step -1
 Dim c As Integer
 c = Asc(Mid(src, i, 1))
 If c >= &H72 Then
 c = c - &H5A ' [r-y]は24-31へ
 ElseIf c >= &H61 Then
 c = c - &H52 ' [a-f]は15-21へ
 ElseIf c >= &H52 Then
 c = c - &H4B ' [R-Y]は7-14へ
 ElseIf c >= &H41 Then
 c = c - &H40 ' [A-F]は1-6へ
 Else
 c = c - &H30 ' [0-9]は0-9へ
 End If
 For j = 1 To 5
 If c Mod 2 = 1 Then
 result = "X" & result
 Else
 result = "O" & result
 End If
 c = c \ 2
 Next
 Next
 src = "O" & result
 result = ""
 Set re = CreateObject("VBScript.RegExp")
 re.Global = True
 re.Pattern = "([XO])\1*"
 For Each m In re.Execute(src)
 Dim l As Integer
 l = m.Length
 Do While l > 0
 If l > &H5E Then
 result = result & "~ "
 Else
 result = result & Chr(l + &H20)
 End If
 l = l - &H5E
 Loop
 Next
 compress5 = result
End Function

Function decompress5(src As String) As String
 Dim result As String, s As String
 result = ""
 s = "O"
 For i = 1 To Len(src)
 For j = 1 To Asc(Mid(src, i, 1)) - &H20
 result = result & s
 Next
 If s = "O" Then
 s = "X"
 Else
 s = "O"
 End If
 Next
 src = Right(result, Len(result) - 1)
 result = ""
 Do While Len(src) > 0
 Dim c As Integer
 c = 0
 For j = 1 To 5
 c = c * 2
 If Left(src, 1) = "X" Then
 c = c + 1
 End If
 src = Right(src, Len(src) - 1)
 Next
 If Len(result) >= 81 Then
 c = c + &H30
 ElseIf c >= &H18 Then
 c = c + &H5A
 ElseIf c >= &HF Then
 c = c + &H52
 ElseIf c >= &H7 Then
 c = c + &H4B
 ElseIf c >= &H1 Then
 c = c + &H40
 Else
 c = c + &H30
 End If
 result = result & Chr(c)
 Loop
 decompress5 = result
End Function

最後の14文字は数字だと決め打ちしてます。


[追追記]

Function compress(src As String) As String
 For i = 0 To 9
 src = Replace(src, Chr(&H30 + i), Chr(&H67 + i))
 Next
 Set re = CreateObject("VBScript.RegExp")
 re.Global = True
 re.Pattern = "([A-FR-Ya-pr-y])\1+"
 For Each m In re.Execute(src)
 re.Global = False
 re.Pattern = m.Value
 src = re.Replace(src, Left(m.Value, 1) & m.Length)
 Next
 compress = src
End Function

Function decompress(src As String) As String
 Set re = CreateObject("VBScript.RegExp")
 re.Global = True
 re.Pattern = "[A-FR-Ya-pr-y][0-9]+"
 For Each m In re.Execute(src)
 re.Global = False
 re.Pattern = m.Value
 Dim s As String
 s = ""
 For i = 1 To Str(Right(m.Value, m.Length - 1))
 s = s & Left(m.Value, 1)
 Next
 src = re.Replace(src, s)
 Next
 For i = 0 To 9
 src = Replace(src, Chr(&H67 + i), Chr(&H30 + i))
 Next
 decompress = src
End Function
◎質問者からの返答

ありがとうございます!

「compress01/decompress01は長さ、文字種に制限はありません。」

これを使用させていただきました。

原本

edcbabcde0y00000X0fffffffff000000000000000000000000000FFFFFFFFF0X00000Y0EDCBABCDE0000000000000077F76F0

に対し、関数compress01を使用したところ、

OX2O2XOXOX2O2XO3X2O3X2OX2O3XO2X2O4XOX2O3XO2X2O3X2OX2O2XO3X2O2XOXO2X2O5X4O2XO2X2O6X2O6X2O6X2O6X2O5XOX2O5X2O5X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O3X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O5XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O3X2O5XOX2O5X2O6X2O6X2O6X2O6X2O5XOX2O2XO2X2O5XO3XOXOXO3XO3XO4X2OXO4XO2XO5XOXO4XO2XO4X2OXO3XO3XO3XOXO2X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2OX3O2X2OX3OXO3X2O3X2OX3O2X2OX2O2XO3X2O3X2O4

こうなりました。これに対し関数decompress01を使用したところ、

元に戻ることを確認しました。

素人質問で申し訳ないのですが、

OX2O2XOXOX2O2・・・

は500桁以上になってしまい容量がむしろ増えているように見えます。

使い方が誤っているかもしれませんので、ご教授いただければ幸いです。規約違反として通知

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ