Excelで質問致します。


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

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

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

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

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

回答の条件
  • 1人1回まで
  • 13歳以上
  • 登録:2011/05/30 11:49:54
  • 終了:2011/06/06 11:50:07

回答(1件)

id:TransFreeBSD No.1

TransFreeBSD回答回数662ベストアンサー獲得回数2652011/05/31 12:54:37

ポイント200pt

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

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文字は数字だと決め打ちしてます。


[追追記]

  • 文字数制限なし、文字種[0-9A-FR-Ya-fr-y]
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
id:miku1973

ありがとうございます!

 

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

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

原本

edcbabcde0y00000X0fffffffff000000000000000000000000000FFFFFFFFF0X00000Y0EDCBABCDE0000000000000077F76F0

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

OX2O2XOXOX2O2XO3X2O3X2OX2O3XO2X2O4XOX2O3XO2X2O3X2OX2O2XO3X2O2XOXO2X2O5X4O2XO2X2O6X2O6X2O6X2O6X2O5XOX2O5X2O5X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O3X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O5XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O3X2O5XOX2O5X2O6X2O6X2O6X2O6X2O5XOX2O2XO2X2O5XO3XOXOXO3XO3XO4X2OXO4XO2XO5XOXO4XO2XO4X2OXO3XO3XO3XOXO2X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2OX3O2X2OX3OXO3X2O3X2OX3O2X2OX2O2XO3X2O3X2O4

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

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

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

OX2O2XOXOX2O2・・・

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

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

2011/06/03 11:38:49
  • id:taknt
    やり方は 質問にあるのと同様ですが、そのものの値ではなく、それらをいったん 二進数に 変換してから 圧縮させたほうが 圧縮率は 高かったような気がします。
  • id:miku1973
    taknt様、ありがとうございます!
    2進数を使うと1と0が連続するのですごく圧縮できそですね!
    この方法でも構いません!
    どうぞよろしくお願い致します!!
  • id:miku1973
    ありがとうございます!
     
    「compress01/decompress01は長さ、文字種に制限はありません。」
    これを使用させていただきました。

    原本
    edcbabcde0y00000X0fffffffff000000000000000000000000000FFFFFFFFF0X00000Y0EDCBABCDE0000000000000077F76F0
    に対し、関数compress01を使用したところ、
    OX2O2XOXOX2O2XO3X2O3X2OX2O3XO2X2O4XOX2O3XO2X2O3X2OX2O2XO3X2O2XOXO2X2O5X4O2XO2X2O6X2O6X2O6X2O6X2O5XOX2O5X2O5X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O2X2O3X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O5XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O2XO3X2O3X2O5XOX2O5X2O6X2O6X2O6X2O6X2O5XOX2O2XO2X2O5XO3XOXOXO3XO3XO4X2OXO4XO2XO5XOXO4XO2XO4X2OXO3XO3XO3XOXO2X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2O6X2OX3O2X2OX3OXO3X2O3X2OX3O2X2OX2O2XO3X2O3X2O4
    こうなりました。これに対し関数decompress01を使用したところ、
    元に戻ることを確認しました。

    素人質問で申し訳ないのですが、
    OX2O2XOXOX2O2・・・
    は500桁以上になってしまい容量がむしろ増えているように見えます。

    使い方が誤っているかもしれませんので、ご教授いただければ幸いです。
  • id:TransFreeBSD
    すみません。compress01はおっしゃる通り圧縮になってません。
    これは単純に1文字を8ビットとしてOXの8文字にしてから連続する場合に縮めているだけなので、まずいきなり8倍にしてしまっていて、その後連続した文字を縮めてはいますが、1文字には0と1両方があるので8倍したのが何分の1かになっている程度で、結局反対に膨らませているだけになります。
    ようするにダメな見本みたいなものです。
    そこで、文字種を限定して1文字5ビットにして、あとは必ず0が続いた後は1、1が続いた後は0になるので、0の数 1の数 0の数… として、さらに英数記号合わせて74文字使ったのが追記したcompress5なのですが、結局文字制限した割に最初のcompress95に負けています。
    考えてみれば当たり前で、1文字中で2回0と1が切り替わるとそれで2文字増えるためです。
    #モノクロ画像などだと有効だと思いますが。

    そんなわけで、2進数化しない方がよいようです。
    なので、最初のcompress95を字数制限なしにしてみました。
    #それと小文字が処理されていなかった部分も修正しました。
    本当はきちんとした圧縮アルゴリズム使えばもっと縮まるかもしれませんが、私にそれを実装するだけの力はありません(^^;
  • id:miku1973
    いえいえ。
    ここまで作成していただき感謝致します。
    自分で理解するのは難しいですが、なんとか上手く改良してでも
    使えればよいなと思います。

    お礼まで。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません