エクセルのセルの中身を分離

よろしく御願いします。
一つにセルに　２０（１２８）のように数字が有ります。
これを２０と１２８に分離してそれぞれファイルを作成
したいのですが、マクロでこのような事出来ますでしょうか。
イメージ
１つのファイルに以下のようなセルがたくさんあります。
〔２０（１２８）〕　〔２７（２３９）〕　・・・・・・・
これを
〔２０〕　〔２７〕　　・・・・・・・
と
〔１２８〕　〔２３９〕　・・・・・・・
の２つのファイルにしたい。〔　　〕はセル

No.2 ベストアンサー 回答者： tom04 回答日時： 2009/11/02 22:37

こんばんは！

すでに回答は出ていますが・・・

一例ですが、
元データが縦に並んでいる場合の回答です。

↓の画像で
B1セルに
=LEFT(A1,FIND("(",A1)-1)

C1セルに
=MID(A1,FIND("(",A1)+1,FIND(")",A1)-FIND("(",A1)-1)
として、B1・C1セルを範囲指定し
C1セルのフィルハンドルで下へコピーすると
画像のような感じになります。

尚、エラー処理はしていません。

もしセルが並んでいないのであれば
No.1さんが仰っていらっしゃるように
区切り位置で区切って置換操作ですかねぇ～！

以上、参考になれば幸いです。m(__)m

この回答へのお礼

ありがとうございます。

分離したものは、ファイルかシートを分けたいのですが
難しいでしょうか。
一つのファイルにこのセルが５０×５０
あるので結構な作業になってしまいます。
またファイルとしては、９６個ほど有ります。
フォルダにに有る９６個のファイルについて、
一括して分離するようなことは出来ませんでしょうか。
お手数ですが回答頂けたら幸いです。

お礼日時：2009/11/02 23:34

No.4 回答者： Wendy02 回答日時： 2009/11/03 10:28

こんにちは。

Main から実行してください。ファイルを複数選択して、Sheet1 (左側端）にあるものとして、処理され、自動的に保存します。正しいファイルでしたら、数分ですべて処理されるはずです。

データは、２０（１２８）というように、二つの数字になっているものとして解釈しますが、数字だけの場合は、1次側に入ります。しかし、( ) の数値は、.Value プロパティからですから、正しく認識されません。1次側にマイナス値として入るはずです。切り分けは、テキストモードですから、全角・半角に関係なく行います。

'-------------------------------------------

'Option Explicit

'標準モジュール
Sub Main()
Dim FileNames As Variant
Dim fn As Variant
Dim i As Long
On Error GoTo ErrHandler
　'実行(現行は、拡張子は、xls になっています）
　FileNames = Application.GetOpenFilename("xls ファイル(*.xls),*.xls", MultiSelect:=True)
　If VarType(FileNames) = vbBoolean Then Exit Sub

　For Each fn In FileNames
　With Workbooks.Open(fn)
　SplitNumbers .Worksheets(1)
　.Save
　.Close False
　i = i + 1
　End With
　Next fn
ErrHandler:
　If Err.Number > 0 Then
　　MsgBox "エラー： " & fn.Name & vbCrLf & Err.Description, vbInformation
　Else
　　MsgBox i & "個のファイルは正常終了しました。"
　End If
　
End Sub
Private Sub SplitNumbers(sh As Worksheet)
　　Dim rng As Range
　　Dim buf As String
　　Dim Ar0 As Variant　'元データ
　　Dim Ar1 As Variant　'1次側
　　Dim Ar2 As Variant　'2次側
　　Dim i As Long, j As Long, v As Variant
　　Dim idxMin1 As Long, idxMax1 As Long
　　Dim idxMin2 As Long, idxMax2 As Long
　　
　　With sh
　　If WorksheetFunction.CountA(sh.Cells) = 0 Then
　　　 MsgBox "データがありません。", vbExclamation
　　　 Exit Sub
　　End If
　　'-------------------------------------------
　　'データ取得：A1 を左端とする範囲を取得
　　Set rng = .Range("A1").CurrentRegion
　　'-------------------------------------------
　　Ar0 = rng.Value '配列に切り替え
　　idxMin1 = LBound(Ar0, 1): idxMax1 = UBound(Ar0, 1)
　　idxMin2 = LBound(Ar0, 2): idxMax2 = UBound(Ar0, 2)
　　
　　ReDim Ar1(idxMin1 To idxMax1, idxMin2 To idxMax2) As Long 'Long型
　　Ar2 = Ar1
　　
　　For i = idxMin1 To idxMax1
　　　　For j = idxMin2 To idxMax2
　　　　　　buf = Ar0(i, j)
　　　　　　If InStr(1, buf, "(", 1) Then
　　　　　　　　Ar1(i, j) = Mid(buf, 1, InStr(1, buf, "(", 1) - 1) 'TextCompare
　　　　　　　　Ar2(i, j) = Mid(Left(buf, Len(buf) - 1), InStr(1, buf, "(", 1) + 1)
　　　　　　Else
　　　　　　　　Ar1(i, j) = CLng(buf)
　　　　　　End If
　　　　Next j
　　Next i
　　End With
　　'シートの右側にデータ出力
　　For Each v In Array(Ar1, Ar2)
　　　　With ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
　　　　　　.Range("A1").Resize(idxMax1, idxMax2) = v
　　　　End With
　　Next
End Sub

No.3 回答者： imogasi 回答日時： 2009/11/02 23:43

質問の書き方が悪い。

例データ
A列　　　B列・・
234　　1
456　　657
11　　　78
・・・
のように、シートのデータの列と行の有様が良くわかるように例を挙げること。
データが縦に並んでいるのか、隣の列にデータがあるのかなどが、判るように。
また（）の話をして要るときに〔２０（１２８）〕　のように{｝を持ち出すのは、｛｝は単なる区切りで書いたのかどうか紛らわしい。
ーーー、
質問文を見ている限り、質問者はVBAの経験あるのかな。
課題丸投げのようだ。コードの意味も良くわからず、コードをコピペして実行して動きました、ありがとうではないのか。
色んなやり方が考えられるが、一例で
必ず全セル（）有りとの前提で
Sub test01()
Dim sh1, sh2, sh3
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set sh3 = Worksheets("Sheet3")
d = sh1.Range("A65536").End(xlUp).Row
MsgBox d
r = sh1.Range("iv2").End(xlToLeft).Column
MsgBox r
For i = 2 To d
For j = 1 To r
s = sh1.Cells(i, j)
p = InStr(s, "(")
sh2.Cells(i, j) = Left(s, p - 1)
sh3.Cells(i, j) = Mid(s, p + 1, Len(s) - p - 1)
Next j
Next i
End Sub
＝＝＝
例データ
A列　　　B列・・
12(234)321(1)
234(456)8(657)
1112(11)345(78)
にたいし全部範囲指定して
編集ー置換
検索する文字列　(*)
置換後の文字列　空白
で
12321
2348
1112345
となる。
ーーー
一方
（）内を捉えるという単純な発想では、正規表現を使って
Sub test02()
Dim s As String
Dim x As Object
Dim sh1, sh2
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet4")
'--
d = sh1.Range("A65536").End(xlUp).Row
'MsgBox d
r = sh1.Range("iv2").End(xlToLeft).Column
'MsgBox r
'--
For i = 2 To d
For j = 1 To r
s = sh1.Cells(i, j)
Set reg = CreateObject("VBScript.RegExp")
With reg
.Pattern = "([（(](.+?)(?=[）)]))\S"
.Global = True
.IgnoreCase = True
Set x = .Execute(s)
If x.Count > 0 Then
For Each y In x
MsgBox x(0)
sh2.Cells(i, j) = Mid(x(0).Value, 2, Len(x(0).Value) - 2)
Next
Else
sh2.Cells(i, j) = ""
End If
End With
Next j
Next i
End Sub
というような方法もある。
＝＝＝＝
この質問は、関数で、やっとこさ出来る課題なので
質問者は関数でやるほうがよかろう。

この回答へのお礼

ありがとうございました。
質問のしかたがまずかったです。
焦っていたもので、乱暴に質問書いていました。

お礼日時：2009/11/03 09:39

No.1 回答者： Cupper 回答日時： 2009/11/02 22:15

「区切り位置」を応用する方法かな

ただし、1列ずつまたは、縦に並んだセルに対してのみの操作になります

　「データ」 → 「区切り位置」
で、データを分けることができます
質問の場合は、"（" を区切り文字として指定することでセルを分けることができます
　「カンマやタブなどの区切り文字によってフィールド毎に区切られたデータ」
を選んで
　区切り文字の 「その他」 を選んだ後に、右隣の入力欄に "（"を入力してください
下の「データのプレビュー 」にセルを分けた時のイメージが表示されます
問題なければ、次で各列のデータ書式を設定して終わりです

セルを分けて表示する開始位置を最後のウインドウの「表示先」で指定することができますから
必要な列に対して繰り返し行い、この表示先を変更してください
そのままにしておくと、分けたいセルとその右隣のセルに値が強制的に入力されてしまいます
（右隣のセルの値が消えてしまいます）
注意してください

最後に "）" を空白に「置換」すれば良いと思います

この回答へのお礼

ありがとうございます。
少し作業が楽になりました。
ただ、一つのファイルにこのセルが５０×５０
あるので結構な作業になってしまいます。
またファイルとしては、９６個ほど有ります。
一つのファイルを行い、この作業を覚えさせて
マクロにして、次にファイルから簡単にさせることは
出来ませんでしょうか。

よろしく御願いします。

お礼日時：2009/11/02 22:50