人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルVBAについて質問です。次のページにあるようなマクロを作ってください。
http://hatena88.web.fc2.com/hatena/newpage2.shtml
なお正解された方には追加ポイントが無い状態で平等に振り分けますが、下記の質問で回答者4の方のような解説を付け加えていただいた方や役に立つ情報を教えてくれた方には追加ポイントのおまけを付けます。もちろんそれが必要なければマクロだけ教えてくださっても結構です。よろしくお願いします。
http://q.hatena.ne.jp/1158311664

●質問者: taroemon
●カテゴリ:コンピュータ
✍キーワード:VBA エクセル ポイント マクロ 回答者
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● arhbwastrh
●5ポイント

回答でなくてすみません。

1234■■■5678ということでしたが・・

1 1234の部分と5678の部分は必ず数字ですか?

2 1234の部分と5678の部分は必ず4文字ですか?(半角、全角は問わない)

3 ■■■の部分は必ず3文字ですか?

4 ■■■の部分は必ず数字以外ですか?

5 1234A■■■A5678 左記のAの部分には、スペース、カンマ、その他何か記号が入りますか?

これが分からないと(私のレベルでは)マクロを作ることができません ^^;

よろしくお願いしますm(__)m


http://q.hatena.ne.jp/answer

◎質問者からの返答

ご質問ありがとうございます。

ちょっと説明不足のようでしたね。

1 半角英数文字と記号です。

2 文字数は変化します。もっと多いです。

3 この部分の文字数も変化します。

4 半角英数文字と記号です。

5 一般的なURLが入る予定です。

以上よろしくお願いします。


2 ● ardarim
●100ポイント

以下、サンプルです。

「1234」と「5678」は他の任意の文字列に置き換えて PatternExtraction() を呼び出すことで対応できます。

「1234」と「5678」で囲まれていないセル値に遭遇した場合の処理は質問になかったため特に記載していません。(B列は空白になります)


Option Explicit
Option Base 0

Sub test()

 ' 語頭の文字 "1234"、語尾の文字 "5678" として真ん中の文字を抜き出す
 ' 語頭、語尾に他の任意の文字列に変更できます。
 Call PatternExtraction("1234", "5678")

End Sub

Function PatternExtraction(prefix As String, suffix As String) As String

 Dim c As String
 Dim r As Long
 Dim pl As Long
 Dim sl As Long
 
 pl = Len(prefix) ' 語頭の文字数
 sl = Len(suffix) ' 語尾の文字数
 
 ' 行1から開始し、A列の値が空白でなくなるまでループ
 r = 1
 Do While ActiveSheet.Cells(r, 1).Value <> ""
 
 ' 現在の行のA列の値を取得
 c = ActiveSheet.Cells(r, 1).Value
 
 ' 語頭の文字列と語尾の文字列が一致するかどうか比較
 If Left$(c, pl) = prefix And Right$(c, sl) = suffix Then
 ' 一致した場合は真ん中だけ切り出し、B列に書き込む
 ActiveSheet.Cells(r, 2).Value = Mid$(c, pl + 1, Len(c) - pl - sl)
 Else
 ' 一致しない場合の処理(質問に記載がないためここでは何もしません)
 End If
 
 ' 次の行へ
 r = r + 1
 Loop

End Function

URLはダミーです。

http://q.hatena.ne.jp/1158563595

◎質問者からの返答

ご回答ありがとうございます。

できました。パーフェクトな回答ありがとうございます。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ