エクセル VBAで複数セルから順番に指定文字を抽出したい

解決済

質問者：y.kimu
質問日時：2017/09/21 13:48
回答数：3件

下記のような記述だと1つ目のセルからは文字列を取得できても
2つ目以降のセルからは文字列を取得することができません。
どうすれば2つ目以降のセルから文字列を取得することができるのでしょうか？
※「<」と「>」で挟まれている間の文字列を取得したいです。
※「<」と「>」が何組あるかは不明です。
※ A列に記載しますが、何行あるかは不明です。
また、A列から抽出した文字列を行ごとに転記したいと考えています。

【↓VBA処理結果例】
　　　列A　　　　　　　　　　　　　　列B　　列C　　　列D　・・・
行1 今日の<天気>は<晴れ>です。　　　　　　天気　　　晴れ
行2 明日の天気は<曇り>です。　　　　　　　曇り
行3 <土曜日>は<暑くなる>でしょう。　　　　土曜日　　暑くなる
・
・
・

Dim str0, str1() As Variant
Dim 指定1, 指定2 As Variant
Dim stidx, h, i, j As Integer

str0 = Range("A1")
指定1 = "<"
指定2 = ">"
stidx = 0
h = 1
i = 1
j = 3

ReDim str1(Int(Len(str0) / 2)) As Variant

Do Until InStr(h, str0, 指定1) = 0
　　stidx = stidx + 1
　　i = InStr(h, str0, 指定1)
　　h = InStr(h + 1, str0, 指定2)
　　str1(stidx) = Mid(str0, i + 1, h - i - 1)
　　Cells(3, j).Value = str1(stidx)
　　j = j + 1
Loop

使用OS：Windows 8
使用ソフト：Microsoft Excel 2007

ご存知の方がおられましたらご回答をよろしくお願いいたします。

①、②、③になる事は絶対にありません。

よろしくお願いいたします。

No.1の回答に寄せられた補足コメントです。補足日時：2017/09/21 14:24
通報する
B列は空欄で、C列以降に順次書き込みたいです。

よろしくお願いいたします。

No.2の回答に寄せられた補足コメントです。補足日時：2017/09/21 14:52
通報する

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (3件)

ベストアンサー優先
最新から表示
回答順に表示

No.3ベストアンサー

回答者： GooUserラック
回答日時：2017/09/21 15:13

こんな感じでは？

Sub test()
Const 開始文字 As String = "<"
Const 終了文字 As String = ">"
Dim 行 As Long
Dim 位置 As Long
Dim 文字列 As String
Dim 列 As Long
Dim 対象 As Boolean
For 行 = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Len(Cells(行, 1).Value) <> 0 Then
列 = 3
対象 = False
For 位置 = 1 To Len(Cells(行, 1).Value)
If Mid(Cells(行, 1).Value, 位置, 1) = 終了文字 Then
対象 = False
Cells(行, 列).Value = 文字列
列 = 列 + 1
End If
If 対象 Then
文字列 = 文字列 & Mid(Cells(行, 1).Value, 位置, 1)
End If
If Mid(Cells(行, 1).Value, 位置, 1) = 開始文字 Then
対象 = True
文字列 = ""
End If
Next
End If
Next
End Sub

- 1
- 件

通報する

この回答へのお礼

ご回答、ありがとうございました。
GooUserラック様のおかげで、解決することが出来ました！
私の勉強不足の為にお時間をおかけし、申し訳ございませんでした。
教えていただいた内容を基に今後とも精進して参ります。

本当にありがとうございました。

通報する

お礼日時：2017/09/21 16:05

No.2

回答者： GooUserラック
回答日時：2017/09/21 14:39

テキストなので、列の関係がよく判らないのですが、抽出した物はＢ列以降に順次書き込むでよろしいですか？（見た目ではＣ列からのように見

えるので確認です）

- 0
- 件

通報する

No.1

回答者： GooUserラック
回答日時：2017/09/21 14:19

次のような事は絶対にないと言う事で良いのでしょうか？

①「今日の<天気>は<晴れです。」
②「今日の<天気<は>晴れ>です。」
③「今日の天気>は<晴れ>です。」

- 0
- 件

通報する

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう！

質問する（無料）

このQ&Aを見た人はこんなQ&Aも見ています

専門家回答数ランキング

専門家

※過去一週間分の回答数ランキングです。

質問する（無料）

他の専門家の回答をチェック

このQ&Aと関連する良く見られている質問

QExcel 一括並べ替えについて

Ａ30からＹ47の範囲で一括並べ替えをしたいのですが
マクロを組めば画像（矢印下の図表）のように並び替える事は可能でしょうか？

毎回コピーペーストでやっていますが、流石に時間ばかり掛かってしんどいです。

マクロや関数などの知識はありません。

知識が必要でしたら、学習用のサイトなども併せてご紹介をお願いします。

※画像が小さくてわかりにくいかもしれませんがどうぞよろしくお願い致します。

Aベストアンサー

No7です。補足了解しました。
以下のマクロを標準モジュールに登録してください。
-----------------------------------------------
Option Explicit
Public Sub 並べ替え()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim row1 As Long
Dim col1 As Long
Dim row2 As Long
Dim col2 As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
sh2.Columns("Z").Clear
row2 = 1
For row1 = 30 To 47
For col1 = 1 To 25
sh2.Cel...続きを読む

他の回答も見る

QWorksheet_Change(ByVal Target As Range)の下に複数範囲

始めまして

Private Sub Worksheet_Change(ByVal Target As Range)が全然整理できないので
アドバイスいただけますか
私の能力は
１、N88 BASIC を少しかじりました
2、エクセルで式の入力は少しできます（ロータス123も少しやりました）
3、昔、クイックベーシックはギブアップしました

最近ずっと、知恵袋やここのｇｏｏのエクセルの掲示板から、やりたいことを
可能にしてくれるマクロを探しているのですが、いろいろな表現があって、全然整理できません
例えば下記のマクロなどです（行には自分でメモを書いています）

Private Sub Worksheet_Change(ByVal Target As Range)
　　If Target.Count > 1 Then Exit Sub
　　'複数個所同時入力を拒否する？　　
　　If ActiveSheet.AutoFilterMode Then Exit Sub
　　'AutoFilterModeだったら拒否する
　　If Not Intersect(Target, Range("A1:D4")) Is Nothing Then
　　MsgBox Target.Address　'実際の処理
　　End If
End Sub

さらには
Private Sub Worksheet_Change(ByVal Target As Range)
　　If Not Intersect(Target, Range("A1")) Is Nothing Then
　　'A1の値が変わった
　　　　MsgBox "セル A1 が変更になりました。" '　<--- A1変更時の処理
　　End If
　　If Not Intersect(Target, Range("B1")) Is Nothing Then
　　　　MsgBox "セル B1 が変更になりました。" '　<--- B1変更時の処理
　　End If
　　If Not Intersect(Target, Range("C1")) Is Nothing Then
　　　　MsgBox "セル C1 が変更になりました。" '　<--- C1変更時の処理
　　End If
End Sub

など・・・
他にも
Dim myRng As Range
Dim r As Range
を使いなさいとか

さらには、

Application.EnableEvents = False
Application.EnableEvents = TRUE
を使いなさい

そのマクロ自体が、別のセルを代入したりすると、もうひとつのイベントを発生させてしまい、プロシージャの中で、無限ループに近い形になっています。（ただし、完全な無限ループではないので、1万回程度で止まります。）そこで、その無限ループをとめなくてはならないので、そうした、
Application.EnableEvents = False
ということをします。

などです

===================================================

そこで、さっぱり整理できないので、自分がやりたいことはマクロでどう書けば良いのかを
教えていただければと思います
教えていただいてから、ひとつ、ひとつ検索して勉強します

下記がマクロでやりたいことです

===================================================
入力を監視するセルは下記の範囲で、範囲ごとにやること（処理）は違います
入力は全て整数です（整数が入力されたらその値に応じてマクロで処理します）
入力値のチェックは「入力規則」でやります(IF文書くのがたいへんそうなので）

入力範囲は

Range("B2,D2,H2,J2")
Range("B3,D3,H3,J3")
Range("B5:B100")　
この範囲に値の貼り付けで入力は禁止です、というか、禁止しないと
だめなようです（Worksheet_Changeは）

Range("H5:H100")
この範囲に値の貼り付けで入力は禁止です、というか、禁止しないと
だめなようです（Worksheet_Changeは）

もっと増えるかもしれませんが、その時はなんとか教えていただいた例を参考にやってみます
いきなりの長文の質問ですみません

用語に不慣れで表現が分かりにくかったら指摘してください
よろしくお願いします
エクセルはバージョン２０１３を使っています
最後まで読んでいただきましてありがとうございました

Aベストアンサー

こんにちは。

>Application.EnableEvents = False　の効果を知るには、無限ループになるようなコードが
書けないとだめということですね
>「そんなコードが書けないのだから、効果を実感できるわけがない」という話ですね
>やっと合点しました

私は、そこまで言うつもりはありません。最初は形式的に書いていて、そのうちに分かるようになるということです。実際に、今、「そんなコード」を本当に書ける人がいるのでしょうか？

らしきコードを書いてみましたが、これでも、実証はできません。途中でエラーがでてしまいます。止める場合は、ESCキーを押します。

'A2に値をいれるマクロ
Private Sub Worksheet_Change(ByVal Target As Range)
　If Target.Count > 1 Then Exit Sub
　If Target.Value = "" Then Exit Sub
　If Target.Address(0, 0) <> "A2" Then Exit Sub
'以上除外設定
Application.EnableEvents = False
Target.Value = Target.Value + 1　　'値に値を入れるから保護する必要があります。
Application.EnableEvents = True
If Target.Value > 10 Then Exit Sub　　'再帰になって場合の気休め。実際は働かない
　Exit Sub
End Sub

最近は、PCそのものの性能がよいせいか、忘れてしまう人がいます。無限ループにならないのは、一回のイベントにわずかなタイムラグが出来て、そのタイムラグが、イベントをキャッチする時間の範囲から外れてしまうから、イベントが終了するわけです。

以下の場合は、EnableEvents =False は、不要です。
マクロで値を入れた時に、再イベントが発生するのです。だから、それを防ぐわけです。
-----------------
　If Not Intersect(Target, Range("B2,D2")) Is Nothing Then
MsgBox Target.Value
MsgBox Target.Address
MsgBox Target.Column
MsgBox Target.Row
End If

If Not Intersect(Target, Range("B5:B10,D5:D10")) Is Nothing Then
MsgBox Target.Value
MsgBox Target.Address
MsgBox Target.Column
MsgBox Target.Row
End If
-----------------

>マクロがエラーで止まって、エラーの行が黄色くなって
>コードが示されるようなことでは、逆にマクロなんか使わない方がよさそうです

問題は、そういう所ではないのです。
最初は、プログラムそのものを体得していくことだと思います。
上達のポイントは、なんとか、何年掛かってもよいからと思いつつ、完成を目指すことです。

その都度、覚えた技術を反映しながら、自分のコレクションに加えていきます。

また、ネットで勉強するにしても、なるべく一定の人のものを追いかけて、その人がどう考えて、そのコードになったのか考えながらでもよいと思います。ある程度の内容になると、その人の人柄がコードに出てきます。

マクロで、自分がやりたいことができるようになるには、なかなか時間が掛かります。でも、それ以上に、相手の期待に沿うというのは、もっと大変なことです。

最近、質問した人は、私の説明を読んで、すぐに諦めてしまって質問を閉じてしまいました。こちらも事情があって、その人のために、大掛かりなプログラムを簡単に公開したくはありません。人にやる気を起こさせるのも技術かもしれません。中には、長いコードをみただけで、自分の質問とは違います、と断ってしまう人。せっかく作っても、予定に間に合わなかったので、ボツ。エラー処理したコードは、内容が複雑になっているから、それはダメ。

他人のためにマクロを書くと考えていたら、とてもやっていられるものではありません。

他の回答も見る

QIF関数複数条件の組み合わせ

いつもご教授いただきましてありがとうございます。

今回IF関数の複数条件についてご教授頂ければ幸いです。

サンプル画像添付しましたように
D列の作業列③に下記条件が一致したら数字を表示させる数式を組みたいです。
IF、OR関数の組み合わせだと思うのですが、複数条件の組み方が苦手なので
質問させていただきました。

①A列の数字の中でが2(B列商品コードの最初の数字)
　 C列の数字の中で04、51、03(B列商品コードの下2桁)だったら1と表示させたい。
※ちなみにC列の条件数値は今後いくつか増える可能性があります。その場合もどういう式にしたらよいか併せてご教授願います。

②A列の数字の中でが2(B列商品コードの最初の数字)
　 C列の数字の中で04、51、03(B列商品コードの下2桁)以外だったら2と表示させたい。

③A列の数字の中でが9(B列商品コードの最初の数字)だったら空白にしたい。

お手数をおかけいたしますが、何卒、ご教授願います。

Aベストアンサー

こんにちは！

せっかく作業用の列①・②を作っていらっしゃいますが、一気にC列に表示する数式にしてみました。

C2セルに
=IF(B2="","",IF(LEFT(B2,1)*1=2,IF(ISNUMBER(FIND(RIGHT(B2,2),"04,51,03")),1,2),""))

という数式を入れフィルハンドルで下へこれ以上データが増えることはない！という位まで
しっかりコピーではどうでしょうか？m(_ _)m

他の回答も見る

Q【エクセル VBA】CSVファイルの結合

以前同じ質問をさせて頂いたのですが、説明不足であったため再投稿いたします。

【エクセル VBA】
VBAを使って複数のCSVを結合させたいのですが、コンマ区切りの値がデータ上に存在するため上手くまとまりません。

バッチ等でまとめる方法ではなく、どうしてもVBAでやらなければならないので、その方法をご教授下さい。

また、結合するCSVはエクセルを開いた時に選択できるようにしたいです。
(特定のファイル上を対象等では無く。)

現在使用しているVBAは以下のものになります。
-----------------------------------------------------

Sub CsvIn()
'CSVファイルの読み込み
Dim CsvFileName As Variant
Dim Li As String
Dim Bf() As String
Dim R As Long
Dim ShMain As Worksheet
Dim FlNo As Integer
Dim FFlNo As Integer

With ThisWorkbook 'シート&パスの設定
Set ShMain = .Worksheets("Sheet1")
ChDrive .Path
ChDir .Path
End With
'複数のファイルの選択を可に設定
CsvFileName = Application.GetOpenFilename _
(filefilter:="CSVファイル(*.csv),*.csv", _
Title:="CSVファイル選択", MultiSelect:=True)
If VarType(CsvFileName) = vbBoolean Then Exit Sub 'キャンセル時の処置
R = 1 '行の初期値
For FlNo = 1 To UBound(CsvFileName) 'ファイル数分ループ
FFlNo = FreeFile '---使用可能なファイル番号取得
Open CsvFileName(FlNo) For Input As #FFlNo
Do Until EOF(FFlNo) '最終行までループ
Line Input #FFlNo, Li '一行読み込み
Bf = Split(Li, ",") 'カンマで分割し配列に代入
If UBound(Bf) >= 0 Then '空白行の処理を飛ばす
With ShMain '1行分のデータをセルに出力
.Range(.Cells(R, 1), Cells(R, UBound(Bf) + 1)).Value = Bf
End With
End If
R = R + 1
Loop
Close #FFlNo
Next FlNo
End Sub

-----------------------------------------------

参考になりそうなサイト
http://excel-ubara.com/excelvba5/EXCELVBA257.html

よろしくお願いします。

Aベストアンサー

No.13 に対する補足コメントについて

ですから！
そのダメな所のデータを数行抜き出したものでＣＳＶファイルを作成して実験してみてください。
それでも症状が出るならばその数行のデータを提示してください。

大変申し訳ないのですが、こちらはそちらの状況が見えないので「特段ルールが異なるようなことはございませんでした。」は、あなたが気づかないだけの場合が多いのでそれを提示していただきたいのです。
「同じ列に似た値があると上書かれてしまうということはありませんでしょうか？」については１文...続きを読む

他の回答も見る

Qエクセルで自動で同じ文字と数字をセルに貼り付ける事は出来るでしょうか？例えば A1○ B1□ C1

エクセルで自動で同じ文字と数字をセルに貼り付ける事は出来るでしょうか？

例えば
A1○　B1□　C1　20枚　と入力したら
○□が一つのセルに20枚自動入力出来るようにしたいです。

数量がかなりあるため出来るだけ自動にしたいので、お手数ですが教えて頂けませんか。

Aベストアンサー

添付図参照

他の回答も見る

Qエクセルでの勤務表作成について

エクセルで勤務表作成をしています。以下のことを自動で表示する関数がありましたら教えて下さい。

①休みの間隔が6日以上空いた場合に色が付く。
②5日勤務で1日休み、その後に5日勤務を入れた時に色が付く。

以上のことが行えると助かります。
よろしくお願いします。

Aベストアンサー

条件書式で、ご希望の状態を検索すればよいと思います。
①　休みの日には勤務時間がゼロのはずです。
それと、以降6日間に勤務時間ゼロの有無を検索すればよいでしょう。
③　任意の5日間にゼロが無く、次のセルがゼロの場合、その後に5日にゼロが無い、
この条件で良いと思います。

他の回答も見る

QExcelの操作について。ことなる列に入力してある数値をひとつのセルに表示させたいのですが、 ↓例

Excelの操作について。

ことなる列に入力してある数値をひとつのセルに表示させたいのですが、

↓例えば、〔〕をセルだとすると

〔1〕〔2〕〔100〕

とあるものを

〔1·2·100〕

というようにまとめる

このようなことは可能ですか？

Aベストアンサー

例えば　セルA1=1　セルA2＝2　セルA3=100　の場合
セルA4＝1･2･100　と表示させたければ、

セルA4＝A1&"･"&A2&"･"&A3

で表示されます＾＾

他の回答も見る

Qエクセルセル内の除去について

エクセルのセル一つについて　「〇○○　　×××　　」と文字○があった場合、〇○○の右の空白のスペースからすべて右側を×××を含めて除去する方法はありませんか。〇○○、×××の文字、文字数はセルごとに違うものとします。

Aベストアンサー

例えば、
A1に、

> 「〇○○　　×××　　」

が入力されているとして、

B1に、
=FIND("　",A1)
で最初に空白文字が現れる文字の場所を取得。

C1に、
=LEFT(A1,B1-1)
で最初に空白が現れるより左の文字列を取得。

とか。

他の回答も見る

QExcel VBA 並び替えについてお手数をおかけします下記条件のようなプログラムを作りたいので

Excel VBA 並び替えについて
お手数をおかけします
下記条件のようなプログラムを作りたいのですがご教授をお願いいたします

sheet1
A1 みかん
A2 りんご
B1 ブドウ
C1 メロン
D1 柿
D2 イチゴ
と記載されているのを
sheet2のB2から縦に並び替えたい
B2 みかん
B3 りんご
B4 ブドウ
B5 メロン
B6 柿
B7イチゴ

ご教授をお願いいたします

Aベストアンサー

No.3 追補

もちろん、以下でもいいです。

Sub 並び替え()
Dim 元行 As Long
Dim 元列 As Long
Dim 先行 As Long
先行 = 2
Sheets("Sheet1").Select
For 元列 = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
For 元行 = 1 To Cells(Rows.Count, 元列).End(xlUp).Row
Sheets("Sheet2").Cells(先行, 2).Value = Cells(元行, 元列).Value
先行 = 先行 + 1
Next
Next
Sheets("Sheet2").Select
End Sub