Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8723 / 13655 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【31620】文字の抽出からコピー 超ビギナー 05/11/27(日) 13:32 質問[未読]
【31623】Re:文字の抽出からコピー とまと 05/11/27(日) 13:46 回答[未読]
【31624】Re:文字の抽出からコピー とまと 05/11/27(日) 13:51 発言[未読]
【31625】Re:文字の抽出からコピー 超ビギナー 05/11/27(日) 14:02 質問[未読]
【31626】Re:文字の抽出からコピー とまと 05/11/27(日) 14:24 回答[未読]
【31627】Re:文字の抽出からコピー 超ビギナー 05/11/27(日) 14:45 質問[未読]
【31628】Re:文字の抽出からコピー とまと 05/11/27(日) 14:56 回答[未読]
【31630】Re:文字の抽出からコピー 超ビギナー 05/11/27(日) 15:03 お礼[未読]
【31631】Re:文字の抽出からコピー ichinose 05/11/27(日) 15:06 発言[未読]
【31632】Re:文字の抽出からコピー とまと 05/11/27(日) 15:20 発言[未読]
【31633】Re:文字の抽出からコピー kobasan 05/11/27(日) 15:32 発言[未読]
【31634】Re:文字の抽出からコピー 超ビギナー 05/11/27(日) 15:42 お礼[未読]
【31620】文字の抽出からコピー
質問  超ビギナー  - 05/11/27(日) 13:32 -
引用なし
パスワード
   １つの列に入力されているデーターの内、（）で囲まれた内容のみを
他の列に移動させたいのですがどのようにすれば可能なのでしょうか？
尚、移動させるときは行を変更せずに移動させたいです。

一応、この質問箱の内容で近いものを試してみたのですがうまくいきま
せんでした。宜しくお願いします。
【31623】Re:文字の抽出からコピー
回答  とまと  - 05/11/27(日) 13:46 -
引用なし
パスワード
   こんにちは　
置換しています。A列のデータをB列に移動します。
括弧の種類違ったら適当に増やしてください。

Sub test()

Columns("A").Copy Range("B1")
Columns("B").Replace "*（", ""
Columns("B").Replace "）*", ""

End Sub
【31624】Re:文字の抽出からコピー
発言  とまと  - 05/11/27(日) 13:51 -
引用なし
パスワード
   ちょっと訂正。

Sub test2()

Columns("A").Copy Range("B1")
Columns("B").Replace "*（", "", xlPart
Columns("B").Replace "）*", "", xlPart

End Sub
【31625】Re:文字の抽出からコピー
質問  超ビギナー  - 05/11/27(日) 14:02 -
引用なし
パスワード
   とまとさん早々の回答ありがとうございます。

早速試してみたのですが、カッコが入力されていないセルの
内容もコピー貼り付けされてしまいます。

カッコが入力されているセルのみ移動させたいのですがどうし
たらよいのでしょうか？

もう一度ご教授願えませんでしょうか。
宜しくお願いします。
　
【31626】Re:文字の抽出からコピー
回答  とまと  - 05/11/27(日) 14:24 -
引用なし
パスワード
   A列にあるものをB列に出力しています。
適宜変更してみてください。

Sub 移動()

Dim vntA
Dim a As Long, b As Long, i As Long

　　　　　　　　　　'↓適宜変更
vntA = Range("A1", [A65536].End(xlUp)).Value
　　　　　　'↑適宜変更
　　　　　　
For i = 1 To UBound(vntA)
If InStr(vntA(i, 1), "（") > 0 Then
　　a = InStr(vntA(i, 1), "（")
　　b = InStr(vntA(i, 1), "）")
　　vntA(i, 1) = Mid(vntA(i, 1), a + 1, b - a - 1)
Else
　　vntA(i, 1) = Empty
End If
Next

Range("B1").Resize(UBound(vntA)).Value = vntA
　　　　'↑適宜変更

End Sub
【31627】Re:文字の抽出からコピー
質問  超ビギナー  - 05/11/27(日) 14:45 -
引用なし
パスワード
   またまたありがとうございます。

試してみたのですが移動やコピー等の変化が
何も起こりません。
私の質問が悪く意図が伝わっていなかったら
申し訳ありません。

　　　　Ａ列　　Ｂ列
1行目　(ABCD)　(ABCD)
2行目　BGDT
3行目　(XYZ)　 (XYZ)
4行目　1234

上記の様にカッコのあるセルのみＡ列からＢ列へ移動させます。
Ｂ列に移動させたものはＡ列から削除できれば完璧です。

何度も質問で申しありませんが宜しくお願いします。
【31628】Re:文字の抽出からコピー
回答  とまと  - 05/11/27(日) 14:56 -
引用なし
パスワード
   ▼超ビギナー さん：
　
勘違いしてました。関数でもできそうだけど。。
これでどうです？


Sub 移動4()

Dim i As Long
Dim ck1 As Long, ck2 As Long

For i = 1 To [A65536].End(xlUp).Row
　 ck1 = InStr(Cells(i, "A").Value, "(")
　 ck2 = InStr(Cells(i, "A").Value, "（")
　 If ck1 > 0 Or ck2 > 0 Then
　　　Cells(i, "B").Value = Cells(i, "A").Value
　 End If
Next
　
End Sub
【31630】Re:文字の抽出からコピー
お礼  超ビギナー  - 05/11/27(日) 15:03 -
引用なし
パスワード
   とまとさん

できました。

長々とお付き合いいただきありがとうございました。
【31631】Re:文字の抽出からコピー
発言  ichinose  - 05/11/27(日) 15:06 -
引用なし
パスワード
   とまと さん、超ビギナー さん
こんにちは。

アルゴリズムを駆使すればできそうですけど
正規表現を使用するとあまり考えなくても
この手のことが実現出来ますよ！！

標準モジュールに
'=========================================
Dim regex As Object
Sub test()
　 Set regex = CreateObject("VBScript.RegExp")
　 ' 正規表現を作成します。
　 For idx = 1 To Cells(Rows.Count, 1).End(xlUp).Row
　　 jdx = 0
　　 If Cells(idx, 1).Value <> "" Then
　　　　ans = spfind(Cells(idx, 1).Value, "\([^\(^\)]*\)")
　　　　Do Until ans = ""
　　　　　Cells(idx, jdx + 2).Value = ans
　　　　　jdx = jdx + 1
　　　　　ans = spfind
　　　　　Loop
　　　　End If
　　 Next idx
　 Set regex = Nothing
End Sub
'=====================================================================
Function spfind(Optional chkstr = "", Optional fstr = "") As String
　 Static matches As Object
　 Static cnt As Long
　 spfind = ""
　 With regex
　　　If chkstr <> "" Then
　　　　 Set matches = Nothing
　　　　 .Pattern = fstr
　　　　 .IgnoreCase = True
　　　　 .Global = True
　　　　 Set matches = .Execute(chkstr)
　　　　 cnt = 0
　　　　 End If
　　 If cnt < matches.Count Then
　　　　spfind = matches(cnt)
　　　　cnt = cnt + 1
　　　　End If
　　 End With
End Function

これでアクティブシートのＡ列の()「（）も含む」内を抜き出して
Ｂ列以降に記述します。

尚、検索対象の()は、半角です。
【31632】Re:文字の抽出からコピー
発言  とまと  - 05/11/27(日) 15:20 -
引用なし
パスワード
   ▼ichinose さん：

正規表現はまだ手をだしていないのですが、
興味ありです(^^
質問しているのを見かけたらご指導ください。
今回のは括弧の中とか関係ないみたいですね。
あせって回答してしまいました。（^^;

関数はりつけるぐらいでも大丈夫そう。。

Sub 移動5()

With Range("A1", [A65536].End(xlUp)).Offset(, 1)
.Formula = "=IF(ISERROR(FIND(""("",A1)),"""",A1)"
.Value = .Value
End With

End Sub

では。
【31633】Re:文字の抽出からコピー
発言  kobasan  - 05/11/27(日) 15:32 -
引用なし
パスワード
   皆さん　今日は。

わかりやく、簡単な方法で、私も。

Sub test2()
Dim r As Range
　　For Each r In Range("a1", Range("A65536").End(xlUp))
　　　　If r.Text Like "*(*)*" Then
　　　　　　r.Offset(, 1) = r.Value
　　　　　　r.ClearContents
　　　　End If
　　Next
End Sub
【31634】Re:文字の抽出からコピー
お礼  超ビギナー  - 05/11/27(日) 15:42 -
引用なし
パスワード
   みなさんありがとうございます。

大変勉強になりました。

最近仕事で色々と作らせられて。。。←無理やり(ToT)

今後も質問させてもらうかと思いますので、そのときには
宜しくお願い致します。

ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8723 / 13655 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free