AIと戦って、あなたの人生のリスク診断 >>

下記のような記述だと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

A 回答 (3件)

こんな感じでは?



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
    • good
    • 1
この回答へのお礼

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

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

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

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

えるので確認です)
この回答への補足あり
    • good
    • 0

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


①「今日の<天気>は<晴れです。」
②「今日の<天気<は>晴れ>です。」
③「今日の天気>は<晴れ>です。」
この回答への補足あり
    • good
    • 0

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

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

QExcel 一括並べ替えについて

A30からY47の範囲で一括並べ替えをしたいのですが
マクロを組めば画像(矢印下の図表)のように並び替える事は可能でしょうか?

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

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

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



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

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.Cells(row2, "Z").Value = sh1.Cells(row1, col1).Value
row2 = row2 + 1
Next
Next
Call sh2.Range("Z1:Z" & row2 - 1).Sort(Key1:=sh2.Range("Z1"), Header:=xlNo)
row2 = 1
For row1 = 30 To 47
For col1 = 1 To 25
sh2.Cells(row1, col1).Value = sh2.Cells(row2, "Z").Value
row2 = row2 + 1
Next
Next
sh2.Columns("Z").Clear
MsgBox ("完了")
End Sub
------------------------------------------------------------------------

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)が全然整理できないので
アドバイスいただけますか
私の能力は
1、N88 BASIC を少しかじりました
2、エクセルで式の入力は少しできます(ロータス123も少しやりました)
3、昔、クイックベーシックはギブアップしました

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

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は)

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

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

始めまして

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

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

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
-----------------

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

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

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

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

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

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

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

こんにちは。

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

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

らしきコードを書いてみましたが、これでも、実証はできません。途中でエラーがで...続きを読む

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



よろしくお願いします。

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

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

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

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



現在使用しているVBAは以下のものになります。
------------...続きを読む

Aベストアンサー

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

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

大変申し訳ないのですが、こちらはそちらの状況が見えないので「特段ルールが異なるようなことはございませんでした。」は、あなたが気づかないだけの場合が多いのでそれを提示していただきたいのです。
「同じ列に似た値があると上書かれてしまうということはありませんでしょうか?」については1文字ずつ「"」「,」が有った時だけ特別な作業をしているだけなので考えにくいです。

もしかしての考えられそうなものとして
・文字コードのせいで1つの2バイト文字が「"」や「,」と何かに分解されてしまっている可能性も有るかもしれません。
・1つの行中で「"」が偶数個でないと誤動作する可能性はあります。
・CSVファイルに特殊な制御コードになりそうな文字が含まれている。
・これは故意にしているのですが空白だけの行は削除していますが問題ないですよね?

とにかく、こちらではそちらの状況が見えないので、ダメな状況を具体的に提示していただけないと実験などが出来ないのです。もしも具体的な提示が出来ないのならばそう言ってください。あなたの事は無視するようにします。
よろしくお願いいたします。

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

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

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

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

QExcel2010で頭が0から始まる数字を表示形式以外で0表示させたい

A列の数字「1701」とB列の数字「001」を「concatenate」で繋ぐ際にB列の数字が3桁「001」なんですが、実際にセルに入っているのが「1」なので、繋いだ際に「17011」となってしまいます。
「001」をデータとするにはどうしたらよいのでしょうか?
宜しくお願いいたします。

Aベストアンサー

> 実際にセルに入っているのが「1」なので、
これを、「'001」と入力してみて下さい。
セル結合「&」で繋げることができます。
「'001」と入力されていても、数値計算時には、数字の「1」として認識されます。
お試しを。


人気Q&Aランキング