（）内のだけ違うセルに

質問

考えましたが思いつかないので知恵を貸してください。

Sheet1に
A列 B列

AAA 10
ABA(X) 20
BBAA 19
AA(XY) 12
BBBA 1.1
BBAA 22
AA(XY) 2.3
BBBA 21
※ランダム ※ランダムな文字列

このように入力されています
これを

C列 D列

AAA 10
ABA 20X
BBAA 19
AA 12XY
BBBA 1.1
BBAA 22
AA 2.3XY
BBBA 21

のようにさせたいのです
つまりは、()を外して違うセルの後ろに（）内の文字を貼り付ける
という作業です。

よろしくおねがいします。

回答No.1

redfox63 · ベストアンサー

こんな感じでしょう

A:B から D:Eへ転記しています
シートモジュールにマクロを記載

Sub Macro1()
　　Dim r1 As Range, r2 As Range
　　Dim ss As String, n As Integer
　　Set r1 = Range("A1")
　　Set r2 = Range("D1")
　　Do While r1.Value <> ""
　　　　ss = r1.Value
　　　　n = InStr(ss, "(")
　　　　' (があるかチェック
　　　　If n > 0 Then
　　　　　　' あった場合はその手前までの文字列にする
　　　　　　ss = Left(ss, n - 1)
　　　　End If
　　　　r2.Value = ss
　　　　Set r1 = r1.Offset(1)
　　　　Set r2 = r2.Offset(1)
　　Loop

　　Set r1 = Range("B1")
　　Set r2 = Range("E1")
　　Do While r1.Value <> ""
　　　　ss = r1.Offset(0, -1).Value
　　　　' 左のセルに( があるかチェック
　　　　n = InStr(ss, "(")
　　　　If n > 0 Then
　　　　　　' ( があるならそれ以降を取得
　　　　　　ss = Mid(ss, n)
　　　　　　' ( ) を削除
　　　　　　ss = Replace(ss, "(", "")
　　　　　　ss = Replace(ss, ")", "")
　　　　Else
　　　　　　ss = ""
　　　　End If
　　　　' 文字列を連結して設定
　　　　r2.Value = r1.Value & ss
　　　　Set r1 = r1.Offset(1)
　　　　Set r2 = r2.Offset(1)
　　Loop
End Sub

お礼

完璧です！ありがとうございました。

このマクロで作成されたセルの組み合わせと同じ組み合わせを
Sheet2から探し、同じ行の指定のセルの文字を抜き出すというはできますか？
質問ばっかりですいません↓

回答No.5

imogasi

#4です。別解を１つ。
Sub test03()
On Error GoTo nxt
d = Range("a6556").End(xlUp).Row
For i = 1 To d
On Error Resume Next
x = Application.WorksheetFunction.Search("(*)", Cells(i, "A").Value)
If Err <> 0 Then
' String Not found
Cells(i, "D").Value = Cells(i, "B")
Else
y = Application.WorksheetFunction.Search(")", Cells(i, "A").Value)
Cells(i, "D").Value = Cells(i, "B") & Mid(Cells(i, "A"), x + 1, y - x)

End If
On Error GoTo 0
nxt:
Next i
End Sub
（と）を両方捉えているので、少しきめ細かいかなと思います。

お礼

お礼が遅くなってすいません
ありがとうございました。無事出来ました↑

回答No.4

imogasi

Sub test02()
d = Range("a6556").End(xlUp).Row
For i = 1 To d
t = Split(Cells(i, "A"), "(")
If UBound(t) > 0 Then
s = Left(t(1), Len(t(1)) - 1)
Cells(i, "C") = Cells(i, "B") & s
Else
Cells(i, "C") = Cells(i, "B")
End If
Next i
End Sub

回答No.3

noname#140971

質問を多少簡略化していますので、そこは応用を！

回答No.2

noname#140971

AAA 10__________AAA 10
ABA(X) 20_______ABA 20X
BBAA 19_________BBAA 19
AA(XY) 12_______AA 12XY
BBBA 1.1________BBBA 1.1
BBAA 22_________BBAA 22
AA(XY) 2.3______AA 2.3XY
BBBA 21_________BBBA 21

A1～A8をB1からB8に転写した結果です。
この場合の式は、

=CutStr(A1, "(",1) & CutStr(A1, ")", 2) & CutStr(CutStr(A1, "(",2), ")",1)

これをズズーッでＯＫです。

Public Function CutStr(ByVal Text As String, _
　　　　　　　　　　　 ByVal Separator As String, _
　　　　　　　　　　　 ByVal N As Integer) As String
　　Dim strDatas() As String

　　strDatas = Split("" & Separator & Text, Separator, , 0)
　　CutStr = strDatas(N * Abs((N <= UBound(strDatas))))
End Function

まあ、CutStr関数一つでも可能です。

お礼

関数ひとつでも可能なんですね・・。
LEFTとLENでごちゃごちゃやったんですが（笑）
ありがとうございました