Excelのマクロで（）内の文字を抽出して書き出したい

質問

HTMLにあるテーブルの部分をコピペして貼り付けたExcelファイルがあります。
A～Cまでの3列が埋まっている状態で、D以降の列は空欄です。
C列に123(1112)というように、数字(数字)の記載になっている部分があります。
()の前と、中は必ず半角数字で、桁は1桁～5桁までと幅広い状態です。
この()内の数値をD～F欄に書き出したいです（縦3列のものを、横3列として書き出したい）

数字(数字)という記載のセルは、必ず縦に3つ並んでいますが
C列は膨大なセル数なうえに、数字(数字)という記述以外のセルも間に入っております（数字のみのセルか、空欄のセルです）
3つ並んでいる部分のみを探して、()内の数値を抽出し、D～F列に書き出すことは可能でしょうか？
書き出す場所は、3つ並んでいるC列の最初のセルの横のD～Fだと助かります。
（数字(数字)がC6～8にあった場合、D6～F6に書き出される）
なお、数字(数字)というセルはC列以外にはなく、4つ以上縦に並ぶ事もありません。

さすがにこのような内容を実行するのは不可能でしょうか？
もし可能でしたら、マクロを組んでいただきたいです・・・よろしくお願いします。

回答No.4

n-jun · ベストアンサー

ANo.3です。

Sub　try2()
　Dim　RegExp　As　Object
　Dim　r　As　Range,　rr　As　Range
　Dim　i　As　Integer,　st　As　String

　Set　RegExp　=　CreateObject("VBscript.Regexp")
　RegExp.Pattern　=　"\d+(\d*)"

　For　Each　r　In　Range("C1",　Cells(Rows.Count,　3).End(xlUp)).SpecialCells(xlTextValues).Areas
　　　　　i　=　1
　　　　　For　Each　rr　In　r
　　　　　　　　　If　RegExp.Test(rr.Value)　Then
　　　　　　　　　　　　st　=　RegExp.Replace(rr.Value,　"$1")
　　　　　　　　　　　　st　=　Replace(Replace(st,　"(",　""),　")",　"")
　　　　　　　　　　　　r.Item(1).Offset(,　i).Value　=　st
　　　　　　　　　　　　i　=　i　+　1
　　　　　　　　　End　If
　　　　　Next
　Next
　Set　RegExp　=　Nothing
End　Sub
こんな感じでしょうか。

補足

こちらの回答を見逃しておりました。すみません。
このマクロで無事横に書き出す事、C列をD列に変更した場合でも
書き出す事ができるようになりました。ありがとうございました。

回答No.6

n-jun

横からで申し訳ないですが。

＞今回はC列のものをD～Fに書き出すやり方を教えていただきましたが
＞1列ずらして、D列のものをE～Gに書き出す場合は
＞どのように変更したら良いのでしょうか？
参照している列と書き出している列の関係について、まず提示されたコードを理解する事が先では。
上記の件については、さほど難しいものではないはずです。
でないと今後のためにもならないと思いますけど。

補足

ご指摘ありがとうございます。
n-junさんが書いてくださったマクロにはC1とあって
列の指定が分かりやすかったのですが
C列を記載している部分を見つける事ができなかった為につい聞いてしまいました。
参照している列の部分を探してみます。

回答No.5

Wendy02

#2です。

#3の補足に書かれている内容が、私のマクロで出来るはずですが、出来ないようでしたら、これ以上は、初歩的な問題のはずですから、こちらからは何も言うことはありません。

補足

週末忙しく、連絡が遅れてしまいました、申し訳ございません。
何度か試してみたところ、問題なく動作しました。
希望通りの動きで、大変感謝しております。

もう一つ質問で申し訳ないのですが
今回はC列のものをD～Fに書き出すやり方を教えていただきましたが
1列ずらして、D列のものをE～Gに書き出す場合は
どのように変更したら良いのでしょうか？
大変お手数おかけしますが、再度ご返答よろしくお願いいたします。

回答No.3

n-jun

ANo.1です。

>Microsoft Excel2002で下記の手順で試しましたが、
>何の変化もありませんでした。間違いがありましたらご指摘ください。
当方もExcel2002ですし、やり方は間違っていないと思います。
シートも特定をしていないので、データのあるシートがアクティブな状態であれば問題ないです。
ただ提示されたＣ列（？）のデータ形式に違いがないかどうか、或いはHTMLからコピペしたデータが、
Ａ～Ｃ列にきちんと区切られて入っているのかどうか
（見た目はＣ列にあっても実際にはＡ列にあるとか）を再確認されては？

補足

申し訳ございません、説明不足だったようです。

>>数字(数字)というセルはC列以外にはなく、4つ以上縦に並ぶ事もありません。
この部分なのですが、必ず3つ単位でセルが並んでいるという意味ではなく下記のような状態となります。
数字と()は全て半角、漢字が入力されているセルもあります。

C1　123(123)
C2　100(90)
C3　100(150)
C4　123456
C5　空欄
C6　200(1500)
C7　500(10000)
C8　1000(1500)
C9　空欄
C10 文字

試してみたところ、C列に3つ単位でセルが並んでいる部分は
マクロを実行することでD～Fに書き出されました。
説明不足で申し訳ございません。

上のようなC列状態でも、D～Fに書き出す事は可能なのでしょうか？
C列にある数字(数字)の部分の()内数値のみをD列に書き出し
D列に3つずつ並んでいる数値をE～Gに横に書き出す…といったような形式になってもかまいません。
大変お手数おかけしますが、よろしくお願いします。

回答No.2

Wendy02

こんばんは。

すでに回答が出ていますが、こういう質問の時は、具体例を示してください。言葉の説明だけでは行き違いがあるかもしれません。ですから、こちらの想像の範囲だけです。
#1さんとは大きな解釈の違いはありませんが、

>123(1112)というように、数字(数字)の記載になっている部分があります。
()の前と、中は必ず半角数字で、桁は1桁～5桁まで

この部分を限定させていただきました。しかし、( ) は、半角という限定です。

なお、ワイルドカードは、
*　は、直前の文字の数が、0～です。
+　は、直前の文字の数が、1～です。

'標準モジュール

Sub Test1()
　　Dim objReg As Object
　　Dim i As Integer
　　Dim j As Long
　　Dim buf As String
　　Set objReg = CreateObject("VBscript.RegExp")

　　With objReg
　　　　'括弧内は、1桁～5桁まで
　　　　.Pattern = "\d+\((\d{1,5})\)"
　　　　.Global = False
　　　　Application.ScreenUpdating = False
　　　　For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row
　　　　　　'3列並んでいるときのみ
　　　　　　If Application.CountA(Cells(i, 3).Resize(3)) = 3 Then
　　　　　　　　For j = 0 To 2
　　　　　　　　　　buf = Cells(i, 3).Offset(j).Value
　　　　　　　　　　If .Test(buf) Then
　　　　　　　　　　　　Cells(i, 3).Offset(, j + 1).Value = .Execute(buf)(0).SubMatches(0)
　　　　　　　　　　End If
　　　　　　　　Next j
　　　　　　　　i = i + j
　　　　　　End If
　　　　Next i
　　　　Application.ScreenUpdating = True
　　End With

　　Set objReg = Nothing
End Sub

補足

ありがとうございます。
ANo.1さんへの補足でも書いたのですが
同じくこちらもSub Test1()～End Subまでをコピーし
Test1を実行したのですが、なにも変化がありませんでした…

具体例といいますと、どこかにExcelシートをアップロードして
ここにURLを貼り付ければよいということでしょうか？

回答No.1

n-jun

Sub　try()
　Dim　RegExp　As　Object
　Dim　r　As　Range,　rr　As　Range
　Dim　i　As　Integer,　st　As　String

　Set　RegExp　=　CreateObject("VBscript.Regexp")
　RegExp.Pattern　=　"\d*(\d*)"

　For　Each　r　In　Range("C1",　Cells(Rows.Count,　3).End(xlUp)).SpecialCells(xlTextValues).Areas
　　　　　If　r.Rows.Count　=　3　Then
　　　　　　　　i　=　1
　　　　　　　　For　Each　rr　In　r
　　　　　　　　　　　　st　=　RegExp.Replace(rr.Value,　"$1")
　　　　　　　　　　　　st　=　Replace(Replace(st,　"(",　""),　")",　"")
　　　　　　　　　　　　r.Item(1).Offset(,　i).Value　=　st
　　　　　　　　　　　　i　=　i　+　1
　　　　　　　　Next
　　　　　End　If
　Next
　Set　RegExp　=　Nothing
End　Sub
質問を取り違えていたらごめんなさい。

補足

どうもありがとうございます。
Microsoft Excel2002で下記の手順で試しましたが、
何の変化もありませんでした。間違いがありましたらご指摘ください。

Excelを起動し、Bookを開く
Alt+F11でMicrosoft Visual Basicを開く
Module1に、上記の Sub try()～End　Subをコピペする
Bookの画面に戻りAlt+F8でtryを実行する

この手順でやってみたのですが、なにもおこりませんでした。
やり方を間違っているのでしょうか？
それとも、Excelのバージョンが古いせいでしょうか。