[[20150822170458]]　『データ区切りができるようにデータを整えたいです』（ririko）　ページの最後に飛ぶ

『データ区切りができるようにデータを整えたいです。』（ririko）

初心者です。PDFからExcelデータにしたいのですが、大量の作業で頭をかかえています。
2004年から2013年まで金額データの作表をするため、データ区切り機能を使いたいのですが、
PDFは桁区切りのかわりにスペースが入っているため
Excelへ貼ると下記の状態になってしまいます。
Poland の2004年は9,909 として作表するのにVBAでどのようにしたらいいですか？

↓貼り付けたデータ（1行はすべて1セルに貼られています。）
2004 2005 2006 2007 2008 2009 2010 2011 2012 2013
Poland 9 909 9 399 12 521 14 002 12 450 8 414 10 309 11 659 10 978 11 241
Portugal 3 680 2 902 3 634 3 630 3 510 2 455 2 659 2 361 2 144 2 509
Romania 3 611 3 797 4 948 5 957 5 524 2 827 3 511 4 025 3 548 3 522
Slovenia 1 248 1 145 1 313 1 525 1 362 957 1 083 1 121 981 968
Spain 23 107 22 182 24 270 27 500 24 200 12 500 14 100 14 000 11 510 11 337
United Kingdom 15 000 12 230 14 460 14 570 13 010 7 820 10 078 11 048 10 259 9 690
Cyprus 403 381 416 534 528 327 366 248 172 139
Poland 9 909 9 399 12 521 14 002 12 450 8 414 10 309 11 659 10 978 11 241
・
・
・

＜使用 Excel：Excel2010、使用 OS：Windows8 ＞

 Poland の2004年度 の 9 909 が 9,909 ということですが、そのあとの 9 が　次の数値だという判断はどうしましょうか？

 たとえば　9 909 102 304 503 とあった場合、 9,909,102 と 304,503 かも？

 仮に、３組続くことはないということだったとしても 9 909 が 9 と 909 かもしれませんね。

 何かルールはありますか？

（β） 2015/08/22(土) 17:31

 追加で

 ロジックでいかようにも対応はできるかと思いますけど United Kingdom なんてのは、ちょっと面倒ですね。
 なかには、Republic of India　と　３語句のものや、それ以上のものもあるかもしれませんしね。

（β） 2015/08/22(土) 18:03

ありがとうございます。
PDFを確認したところ、99円以下になる年のデータはありませんでした。
最小単位で百円、最大でも万円までになっています。
おっしゃるとおりで３組続くことはなかったのですが、
すべての年が百円台までの国もありました。
このルールで可能でしょうか。宜しくお願いいたします。

国名ですが、国の数と出てくる順番は決まっているので
貼り付けたデータにIDをつけて対応表をまずつくることにしました。
下記のB列のデータの国名を最初に削除してしまいたいです。

A列　　 B列
ID　　　2004 2005 2006 2007 2008 2009 2010 2011 2012 2013
001 　 Poland 9 909 9 399 12 521 14 002 12 450 8 414 10 309 11 659 10 978 11 241
002 　 Portugal 3 680 2 902 3 634 3 630 3 510 2 455 2 659 2 361 2 144 2 509
・　　　　・
・　　　　・
（ririko） 2015/08/22(土) 18:34

 少しクリアになりましたね。

 A列にIDをセットせずとも、もともとの文字列のまま 国名と数値群をわけることはできます。

 課題は 123 456 とあった時に 123 と 456 なのか 123,456 なのか、それをどのように判定するかということですね。
 組み合わせた結果数と年度数とのつきあわせが１つの方法でしょうけど、絶対に不可能な部分もありますね。
 123 456 789 とあり、年度が２つだけという簡単なケースでも 123 と 456,789 なのか 123,456 と 789 なのか??

 これは【神のみぞ知る】というものですよねぇ・・・

（β） 2015/08/22(土) 18:52

 >>国名を最初に削除してしまいたいです。

 当初のA列のデータのままで国名とそれ以外を分離するところまでの途中経過コードです。
 元シートが"Sheet1" これを "Sheet2"に分解転記します。

 あとは、この数字の中身の分解と結合ですね。

 ３桁数字と３桁数字の結合は無いという条件をいれられるなら、この先進めることができますが
 そうじゃないと、先にコメントした通り理論的には無理ですね。

 とりあえず、国名分離までのコード。

 Sub Test()
    Dim reg As Object
    Dim c As Range
    Dim w As Variant
    Dim x As Long

    Dim mt As Object

    Set reg = CreateObject("VBScript.RegExp")
    reg.Pattern = "^[^\d]+"
    With Sheets("Sheet1")
        ReDim w(1 To .Range("A" & Rows.Count).End(xlUp).Row, 1 To 2)
        For Each c In .Range("A1").Resize(UBound(w, 1))
            x = x + 1
            Set mt = reg.Execute(c.Value)
            If x = 1 Or mt.Count = 0 Then
                w(x, 2) = c.Value
            Else
                w(x, 1) = Trim(mt(0).Value)
                w(x, 2) = Mid(c.Value, mt(0).Length + 1)
            End If
        Next
    End With

    With Sheets("Sheet2")
        .UsedRange.ClearContents
        .Range("A1").Resize(UBound(w, 1), UBound(w, 2)).Value = w
    End With

 End Sub

（β） 2015/08/22(土) 20:07

 データ区切りの手前まで？

 Sub test()
    Dim a, i As Long
    With Cells(1).CurrentRegion
        a = .Value
        With CreateObject("VBScript.RegExp")
            .Global = True
            For i = 1 To UBound(a, 1)
                .Pattern = "([a-z]) (\d)"
                a(i, 1) = .Replace(a(i, 1), "$1|$2")
                .Pattern = "\b(\d{1,3}) (\d{3})\b"
                If .test(a(i, 1)) Then a(i, 1) = .Replace(a(i, 1), "$1,$2|")
            Next
        End With
        .Offset(, 1).Value = a
    End With
End Sub
（seiya） 2015/08/22(土) 20:50

 とりあえず、３桁数字と３桁数字の結合はないという前提です。素直というか、力技のコードになりましたが。
 SHeet1のA列のデータをSheet2に展開します。

 Sub test()
    Dim reg As Object
    Dim c As Range
    Dim w1 As Variant
    Dim w2 As Variant
    Dim x As Long
    Dim mcnt As Long
    Dim mt As Object
    Dim wStr As String
    Set reg = CreateObject("VBScript.RegExp")
    reg.Pattern = "^[^\d]+"
    With Sheets("Sheet1")
        ReDim w1(1 To .Range("A" & Rows.Count).End(xlUp).Row, 1 To 1)
        ReDim w2(1 To UBound(w1, 1))
        For Each c In .Range("A1").Resize(UBound(w1, 1))
            wStr = Trim(c.Value)
            x = x + 1
            If x = 1 Then
                w2(x) = Split(wStr)
                mcnt = UBound(w2(x)) + 1
            Else
                Set mt = reg.Execute(wStr)
                If mt.Count > 0 Then
                    w1(x, 1) = Trim(mt(0).Value)
                    w2(x) = GetNums(Mid(wStr, mt(0).Length + 1), mcnt)
                End If
            End If
        Next
    End With

    With Sheets("Sheet2")
        .UsedRange.ClearContents
        .Range("A1").Resize(UBound(w1, 1)).Value = w1
        .Range("B1").Resize(UBound(w2, 1), mcnt).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(w2))
    End With

 End Sub

 Private Function GetNums(s As String, mx As Long) As Variant
    Dim tmp As Variant
    Dim ans As Variant
    Dim x As Long
    Dim z As Long
    Dim num As String

    ReDim ans(0 To mx - 1)
    tmp = Split(s)

    For x = LBound(tmp) To UBound(tmp)
        If Len(tmp(x)) < 3 Then
            num = tmp(x)
        Else
            num = num & tmp(x)
            If z > UBound(ans) Then Exit For
            ans(z) = num
            num = ""
            z = z + 1
        End If
    Next

    GetNums = ans

 End Function

（β） 2015/08/22(土) 21:34

すごいです！国名の分離もそのままきれいにできて、求めるかたちのデータができました！
前後しますが、３桁数字と３桁数字の結合はなかったので教えていただいたもので完璧です。
作業に数日かかると思っていたのが瞬時にできてうれしいです
ありがとうございました。

できれば、^[^\d]+"が何かおしえてください。
あとは少しずつ調べてみます。

（ririko） 2015/08/22(土) 23:39

 ちょい改良
 Sub test()
    Dim a, i As Long, ii As Long
    With Cells(1).CurrentRegion.Resize(, 11)
        a = .Offset(1).Value
        With CreateObject("VBScript.RegExp")
            .Global = True: .IgnoreCase = True
            For i = 1 To UBound(a, 1)
                .Pattern = " ((\d{1,2} )?\d{3})"
                If .test(a(i, 1)) Then
                    For ii = 0 To .Execute(a(i, 1)).Count - 1
                        a(i, ii + 2) = Replace(.Execute(a(i, 1))(ii).submatches(0), " ", ",")
                    Next
                End If
                .Pattern = " \d.*$"
                If .test(a(i, 1)) Then a(i, 1) = .Replace(a(i, 1), "")
            Next
        End With
        .Rows(1).Offset(, 1).Resize(, 10).Value = Split(.Cells(1).Value)
        .Offset(1).Value = a
    End With
End Sub
（seiya） 2015/08/23(日) 03:24

 コードでは『正規表現』と呼ばれるものを使っています。
 使っているといっても、βのコードでは、ほんのちょっと利用しているだけで、
 "^[^\d]+"　というパターンで、文字列先頭の「数字ではない」部分を抜出ているだけです。
 （抜き出した部分は mt(0) というオブジェクトになっています。その桁数は mt(0).Length で取得できます）

 これだけしかやっていないので、正規表現を持ち出さなくても、コードは書けるわけですが、
 面倒だったので、ちょこっと使いました。あとは【平文】のコードになっていますので、おいかけていただければ
 何をしているのかがわかるかと。

 seiyaさんのコードはいいですねぇ。すべてを正規表現で（,付きの編集さえも）実現。
 1～2桁の数字と半角スペースと3桁数字の連なりがあれば　、それを nn,nnn といったものに変更したうえで
 Splitをかけておられます。

 勉強になります。

（β） 2015/08/23(日) 05:19

 私のコードで　GetNums　をつかって、ゴテゴテやっているところを、seiyaさんのパターンを、そのまま
 いただいて組み入れて、ちょっとスリムにしてみました。（ほとんどseiyaさんのコードのパクリです）

 Sub test2()
    Dim reg As Object
    Dim c As Range
    Dim x As Long
    Dim mcnt As Long
    Dim mt As Object
    Dim wStr As String
    Dim vntM As Variant
    Dim w As Variant
    Dim v As Variant
    Dim aStr As String
    Dim mStr As String
    Dim sm As Object
    Dim n As Long

    Set reg = CreateObject("VBScript.RegExp")
    With Sheets("Sheet1")
        vntM = Split(Trim(.Range("A1").Value))
        mcnt = UBound(vntM) + 1

        With .Range("A1").CurrentRegion.Columns(1)
            w = .Offset(1).Resize(.Rows.Count - 1)
        End With

        ReDim v(1 To UBound(w), 1 To mcnt + 1)

        For x = 1 To UBound(w, 1)
            wStr = Trim(w(x, 1))
            reg.Pattern = "(^[^\d]+)"
            reg.Global = False
            aStr = Trim(reg.Execute(wStr)(0))
            mStr = Trim(Mid(wStr, Len(aStr) + 1))
            reg.Pattern = "(\d{1,2} )?(\d{3})"
            reg.Global = True
            Set mt = reg.Execute(mStr)
            v(x, 1) = aStr
            n = 1
            For Each sm In mt
                n = n + 1
                If n > UBound(v, 2) Then Exit For '念のため
                v(x, n) = Replace(sm.Value, " ", ",")
            Next
        Next

    End With

    With Sheets("Sheet2")
        .UsedRange.ClearContents
        .Range("B1").Resize(, mcnt).Value = vntM
        .Range("A2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
    End With

 End Sub

（β） 2015/08/23(日) 09:43

β様、seiya様
すべてのやり方で求める結果が得られました。感動です！
照らし合わせて勉強できます。ありがとうございました。
またわかりやすく説明してくださりほんとうにありがとうございました！

（ririko） 2015/08/23(日) 10:57

コメント返信：

[ 一覧(最新更新順) ]

[[20150822170458]] 『データ区切りができるようにデータを整えたいです』（ririko） ページの最後に飛ぶ

[[20150822170458]]　『データ区切りができるようにデータを整えたいです』（ririko）　ページの最後に飛ぶ