出産前後の痔にはご注意!

Excel2003でVBAを使って、次の2点のことを行いたいと思っております。

1)全角・半角文字が混在している大量のデータから半角英数記号だけを取り出す。

過去のQ&A(http://oshiete1.goo.ne.jp/qa3158346.htmlのNo.3)から類似した回答を見つけましたが、この方法ですと「=AtoZ(A1)」とセルを指定しなければいけません。一度に半角英数記号を取り出す方法はございませんか?

2)抽出するデータは英文で1つのセルに複数の文章が入力されているのですが、文章を区切って1つのセルには1文のみの入力にする。

例えば、下記の文章がA3にあるとします。
Spring came. Freddie, the leaf, was born on a branch of a tall tree. Hundreds of leaves were born on the tree. They were all friends.
これを
A3にはSpring came.
A4にはFreddie, the leaf, was born on a branch of a tall tree.
A5にはHundreds of leaves were born on the tree.
A6にはThey were all friends.
と入力したいのですが、方法はございませんか?

膨大なデータを扱うため、大変困っています。どなたかご教授お願いします。

このQ&Aに関連する最新のQ&A

A 回答 (4件)

1については、引数をループで回せばよいのかな、と直感的に思います.検証できていませんが




2については、
Splitを使ったら簡単にかけるのではないでしょうか?

前提としては各文の終わりにちゃんとピリオドが書いてあることですね

Dim Sentence() As String
Dim Row as Long
Dim Counter as Long
Row = 3

Sentence = Split(Cells(3,1).Value, ".")'A3セルの中身を.で切って配列に格納
For Counter = 0 To UBound(Sentence)
Cells(Counter + 3, 1).value = Sentence(Counter) & "."
Next Counter

と言う感じでしょうか
動作確認をしていませんが・・・


回答になっているでしょうか?
    • good
    • 1

#2さんが言われるように、エクセルの仕事ではありません。



私なら。まず正規表現が扱えるテキスト・エディタを入手します。
フリーソフトでも良いかも知れませんが、有料ですが以下のソフトがあります。
http://www.villagecenter.co.jp/soft/wz50/
http://www.rimarts.co.jp/dana-j.htm
http://hide.maruo.co.jp/software/hidemaru.html

「メモ帳」では正規表現が使えませんし、膨大なデータなら、「メモ帳」では扱えない大きさでしょう。

エクセルからテキスト・ファイルとして保存すれば、テキスト・テディタで読み込むことができます。

また、
> 全角・半角文字が混在している大量のデータから半角英数記号だけを取り出す。
と言われていますが、「取り出す」とは単なる「検索」なのか「置き換え」なのか、
「取り出して」その後どうしたいのかを書かないと、的確な回答は得られないと思います。
    • good
    • 0

こんばんは。



両方とも、Excel向きではありませんね。
特に、膨大なデータならなおさらだと思います。
本来、テキストファイルの中で処理したほうが早いです。

もしかしたら、私と同業者?(私の場合は、もう少し複雑なんです)なのかもしれませんが、特に、2番目のセンテンス切り分けですが、正しく、最初大文字でセンテンスの最後が「.(ピリオド)」で終わっているならよいのですが、実際は、そういうことにならないことが多いのです。それで、結局、後から、手動で入れていくことが多いですね。
ただ、正規表現のマニュアルを手に入れて、後は、ご自身でやってみてください。他人にいちいち聞いているよりも、そのほうが早いです。練習は、エディタ上でしてください。後戻りが利きます。文系・理系を問わず、テキスト処理する人は、正規表現は必須です。

'標準モジュールに貼り付けてください。
'-----------------------------------------------
'半角英数抽出
'-----------------------------------------------
Sub TestRegExp1()
  Dim Buf2 As Variant
  Dim dummy As Variant
  Dim myData As String
  Dim c As Variant
  Dim i As Long
  i = 1
  For Each c In Range("A1:A10") '検索範囲
   If VarType(c) = vbString Then
    Buf2 = OneByteChar(c.Value)
    On Error Resume Next
    dummy = UBound(Buf2)
    On Error GoTo 0
    If IsNumeric(dummy) Then
    'コピー先
     Worksheets("Sheet2").Cells(i, 2).Resize(UBound(Buf2) + 1).Value _
        = WorksheetFunction.Transpose(Buf2)
      i = i + 1 + UBound(Buf2)
    End If
    Buf2 = ""
    dummy = ""
   End If
  Next c
  
End Sub
Function OneByteChar(ByVal strText As String)
'正規表現抽出
 Dim Buf() As String
 Dim myPat As String
 Dim Matches As Object
 Dim Match As Object
 Dim i As Long
  
 myPat = "[\dA-z]+"
 
  With CreateObject("VBScript.RegExp")
    .Global = True
    .IgnoreCase = False
    .Pattern = myPat
    Set Matches = .Execute(strText)
    For Each Match In Matches
      ReDim Preserve Buf(i)
      Buf(i) = Match
      i = i + 1
    Next Match
  End With
  OneByteChar = Buf()
End Function

'-----------------------------------------
'センテンス抽出
'-----------------------------------------
Sub TestRegExp2()
  Dim Buf() As String
  Dim myData As String
  Dim myPat As String
  Dim Matches As Object
  Dim Match As Object
  Dim i As Long
  
  '元のデータ
  myData = Range("A3").Value
  
  myPat = "([A-Z][^\.]+\.)"
  
  If myData = "" Then MsgBox "データがありません", 48: Exit Sub
  With CreateObject("VBScript.RegExp")
    .Global = True
    .IgnoreCase = False
    .Pattern = myPat
    Set Matches = .Execute(myData)
    For Each Match In Matches
      ReDim Preserve Buf(i)
      Buf(i) = Match
      i = i + 1
    Next Match
  End With
  Range("A3").Resize(UBound(Buf()) + 1).Value = WorksheetFunction.Transpose(Buf())
End Sub
    • good
    • 0

やろうとしていることと 条件が合わないように見えるんですが……



=TRIM(MID(SUBSTITUTE(A$3,".","."&REPT(" ",255)),(ROW(A1)-1)*256+1,255))

これでいいなら。
    • good
    • 0

このQ&Aに関連する人気のQ&A

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

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

このQ&Aを見た人が検索しているワード

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

Q全角・半角混在の文字列から半角文字のみ取り出す

エクセル勉強中です。問題集で理解できないところがあります。
数式がどういう意味をもつのか教えて頂けるとありがたいです。
よろしくお願いします。

画像添付の問題になります。
A列に製品名が入っています。(製品番号:半角文字)(製品名:全角文字)
B列に半角文字の製品番号だけを取り出しなさいというものです。
半角文字の開始位置がバラバラになっているところが問題のポイントになっています。

回答ですが
B2:
=MID(A2,MATCH(1,INDEX(LENB(MID(A2,COLUMN(2:2),1))*1,0),),LEN(A2)*2-LENB(A2))
こちらで半角文字のみ取り出せるようです。回答には数式のみで何故この関数を使うのか?
使うことでどういった結果を導くなどの解説が一切ありません。(ちなみに出版会社の便利技的な問題集です)

MID関数で製品名A2から開始位置を指定して、全角半角をLEN関数LENB関数で半角文字数を
算出して文字列を抽出するという事は理解できます。
ただ、この開始位置の指定の所が理解できません。
数式を分割してみましたが
=MID(A2,COLUMN(2:2),1)の所はどの行も製品名の1文字目ですよね・・・
その値にLENB関数で文字数?
数式の検証で見てみると配列のような結果が次々と現れて・・・
MATCH関数もありますしINDEX関数が何か関係しているような気はしているのですが、
INDEX関数と言えば配列に行番号・列番号と例えば表の該当するセルの位置抽出の
知識しかありません。一つのセルでINDEX関数?

すいません。独学で勉強していてこの程度の知識ですが、この数式の考え方教えてくださる方よろしくお願いします。

エクセル勉強中です。問題集で理解できないところがあります。
数式がどういう意味をもつのか教えて頂けるとありがたいです。
よろしくお願いします。

画像添付の問題になります。
A列に製品名が入っています。(製品番号:半角文字)(製品名:全角文字)
B列に半角文字の製品番号だけを取り出しなさいというものです。
半角文字の開始位置がバラバラになっているところが問題のポイントになっています。

回答ですが
B2:
=MID(A2,MATCH(1,INDEX(LENB(MID(A2,COLUMN(2:2),1))*1,0),),LEN(A2)*2-LENB(A2))
こち...続きを読む

Aベストアンサー

ご質問のような半角文字を抽出するなら、提示された数式は一部非効率でわかりにくいところがありますが、個人的には最も簡単な配列数式になっていると思いますので参考までに検証方法を補足します。

まずB2セルに以下の式を入力してください(半角文字が11文字目までに出現する場合)。

=MID(A2,MATCH(1,INDEX(LENB(MID(A2,COLUMN(A:K),1)),0),),LEN(A2)*2-LENB(A2))

COLUMN関数の部分はROW関数で以下のようにするほうが数式がわかりよいかもしれません。

=MID(A2,MATCH(1,INDEX(LENB(MID(A2,ROW($1:$11),1)),0),),LEN(A2)*2-LENB(A2))

この画面上部の数式バーの数式のCOLUMN(A:K)(またはROW($1:$11))の部分をドラッグして選択しF9キーを押すと,「{1,2,3,4,5,6,7,8,9,10,11}」と表示されます(Escで解除)。

次に、MID(A2,COLUMN(A:K),1)の部分を選択し、F9キーを押すと、「{"お","徳","用","M","G","0","5","K","R","カ","ラ"}」とA2セルの先頭から11文字目までの文字が取得できていることがわかります。

次に、LENB(MID(A2,ROW($1:$11),1))の部分を選択し(INDEXを含む部分はこの配列を範囲に変換しているだけですので、この部分を省略するならCtrl+Shift+Enterで確定する必要があります)、F9キーを押すと、「{2,2,2,1,1,1,1,1,1,2,2}」のように、それぞれの文字の半角、全角が1と2で表示されます。

次にMATCH(1,INDEX(LENB(MID(A2,ROW($1:$11),1)),0),)の部分はMATCH関数(第三引数が0または省略)で1(=半角文字)が最初に出現する場所を調べています(上記の例なら4番目)。

ご質問のような半角文字を抽出するなら、提示された数式は一部非効率でわかりにくいところがありますが、個人的には最も簡単な配列数式になっていると思いますので参考までに検証方法を補足します。

まずB2セルに以下の式を入力してください(半角文字が11文字目までに出現する場合)。

=MID(A2,MATCH(1,INDEX(LENB(MID(A2,COLUMN(A:K),1)),0),),LEN(A2)*2-LENB(A2))

COLUMN関数の部分はROW関数で以下のようにするほうが数式がわかりよいかもしれません。

=MID(A2,MATCH(1,INDEX(LENB(MID(A2,ROW($1:$11),1))...続きを読む

Q文字列から英数字のみを抽出する関数

文字列から英数字のみを抽出する関数を教えていただきたいです。

セルの文字列にはひらがな、カタカナ、数字、アルファベット、記号等を含みます。

色々調べてはみたのですが、数字のみを抽出する関数の説明はたくさんありますが、
アルファベットも含むとなると見つかりませんでした。

数字0~9とアルファベット27個の計37個の文字なので、どうにか関数でできると思うのですが。

具体的には下記のようにしたいのです。

●A列
今日iPhone5をauで購入
最新のNEWSを15時~PCで見る 
Moonshotを生み出す「Google X」

●B列にこう表示したいのです。
iPhone5au
NEWS15PC
MoonshotGoogleX


スペースは残ったままでも結構です。

詳しい方、どうかよろしくお願いいたします。

Aベストアンサー

>数字のみを抽出する関数の説明はたくさんありますが

文字列の中に数字が「一塊だけ」ある場合の説明は多分沢山ありますが、(今回のご質問のように)「文字数字文字数字文字数字」と不定数入り混じってる場合の数式は、全く見つからなかったと思いますよ。

たとえば「英数字が最大限3カタマリまで」といった制約を付けて無理矢理関数をくっつける事は出来なくはありませんが、正直不細工ですし、そもそもあんまり現実的じゃありません。



手順:
ALT+F11を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

public function myf(a) as string
 dim i as long
 for i = 1 to len(a)
 if mid(a,i,1) like "[0-9a-zA-Z ]" then
  myf = myf & mid(a,i,1)
 end if
 next i
end function

ファイルメニューから終了してエクセルに戻る

任意のセルに元の言葉を記入し、
=myf(A1)
のように計算する。

>数字のみを抽出する関数の説明はたくさんありますが

文字列の中に数字が「一塊だけ」ある場合の説明は多分沢山ありますが、(今回のご質問のように)「文字数字文字数字文字数字」と不定数入り混じってる場合の数式は、全く見つからなかったと思いますよ。

たとえば「英数字が最大限3カタマリまで」といった制約を付けて無理矢理関数をくっつける事は出来なくはありませんが、正直不細工ですし、そもそもあんまり現実的じゃありません。



手順:
ALT+F11を押す
現れた画面で挿入メニューから標準モ...続きを読む

Qエクセルで、半角文字列を抽出するには

使用機種はXPでEXCEL2003です。

住所のデータ整理をしています。
地名の後の番地のみ半角数字(ハイフンも半角)で入力されており、その部分だけを別の列に移動させる作業です。

関数で、半角文字列だけを抽出することはできますか?
left関数を使おうとも思いましたが、文字数がバラバラなので、難しいと思いました。

私は、一つひとつコピー→ペーストをするしか思いつかないほどの初心者です。
どうぞよろしくお願いいたします。

Aベストアンサー

当該住所がA1に入っていると仮定して
=RIGHTB(A1,LENB(JIS(A1))-LENB(A1))
でどうでしょう?

住所だけ(番地以外)を抜き出すのは
=LEFT(A1,LEN(A1)-LENB(JIS(A1))+LENB(A1))
です。

QEXCEL 文字列操作

教えてください。

たとえば、エクセルのセルの
 AAA555さくらサクラ
という文字列から、英数字だけ抜き出す方法を教えてください。
文字列は可変(不規則な長さ)で、文字列中には英数の他にひらがな、
カタカナ、漢字があります。
例の結果として、AAA555を抜き出したいです。

Aベストアンサー

◆英数字の後にひらがな、カタカナ、漢字が並んでいるものとします
(ひらがな、カタカナ、漢字は順不同でも可)
B1=LEFT(A1,MATCH(1,INDEX(1/(CODE(MID(ASC(A1),ROW($1:$50),1))>5000),),0)-1)

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QExcel 文字列の中から数字だけを削除したい

Excel 2007で各セルに文字列として入力されている、数字を削除し文字だけにしたい。
数字は先頭に入力されています。(顧客コード)

例:
12345-001 ABC株式会社
98765- ZYX有限会社ごお商会 等

数字を削除し文字列だけで元のセルにセットしたいです。


きっと簡単なことなんでしょうけど、過去を検索しても良くわかりませんでした。

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

Aベストアンサー

[No.3お礼]へのコメント、

私が提示した式の意味が分かる(と思う)添付図を参照ください。
B1: =TRIM(ASC(A1))
C1: =FIND(" ",B1)
D1: =MID(B1,C1+1,99)

最後の式中の B1、C1 に上2つの式を代入すれば、提示式になります。

セル A2 の「ZYX有限…」の直前は全角スペースだったので、半角スペース1個にするために、先ずはASC関数で全角スペース1個を半角スペース2個にし、TRIM関数で複数個の半角スペースを1個に置き換えています。ちなみに、文字列の左端や右端にスペースがあればそれらを除去します。
最初のスペースの「次」から文字列を切り出すので「+1」になっています。
A列の文字数は百文字以上は考えなくてよかろうと推測して「99」にしました。

【注意】3行目以降に示したように、全角アルファベットおよび全角カナは、何れも半角文字になってしまいます。

以上の解説で分からなければ、貴方の「レベル」に合った回答に従ってください。

QVBAで英数字入力チェックしたい。

いつもお世話になります。

いままで、ある項目の入力チェックを数字のみで
行っていたところ【IsNumeric】を英数字で行いたいのですが
いくら調べても見当たりません・・・

知っている方、どうかご指南ください。
よろしくお願いします。

Aベストアンサー

IsAlphaが無いですね。
チェック用に、半角に統一して(StrConv)文字列を作り、
1字づつ、JISコードの65-90、97-122をエラーにするチェックを行い、上記作った文字列はチェック後は使い捨てる。
こういうルーチンを作るより他ないでしょう。
記号なども含めて考える。
ただ記号は十分検討が必要です。制限しすぎると、運用後にダウンとか、大騒ぎになる恐れをこめてます。

QEXCELで、セル内の半角カナのみを削除する関数

いつもお世話になっております。
EXCELで、セル内の半角カナのみを削除する関数はございますでしょうか?

    A     B 
1  タナカ田中    田中
2  キノシタ木下   木下
3  オノ小野    小野

といった具合です。
よろしくお願いいたします。

Aベストアンサー

こんにちは。

例えば、

半角カタカナ+全角 というようになっているのでしたら、

=MID(A1,MATCH(TRUE,INDEX(CODE(MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1))>256,,),0),255)

このような数式で、削除することが可能です。(ただし、数字やアルファベットも含みます。それを、半角カタカナでくくることも可能ですが、数式が長くなりすぎます。)

しかし、それ以上に、半角カタカナと全角とが混在していたり、英数と混在していて、半角カタカナだけを削除するのは、上記のような数式ではうまくいきません。

その場合は、例えば、以下のようなユーザー定義関数を使うことになります。
'標準モジュール登録

Public Function DOBK(ByVal myStr As String) As String
'DelOneByteKana ->DOBK
Dim Re As Object, Matches As Object, Match As Object
Dim Buf As String
With CreateObject("VBScript.RegExp")
'厳密には、Unicodeの半角カタカナの範囲ですから、JISの\xA1~\xDFとは違っています。
  .Pattern = "[\uFF66-\uFF9F]"
  .Global = True
  Buf = myStr
  If .test(Buf) Then
    Set Matches = .Execute(Buf)
    For Each Match In Matches
      Buf = Replace(Buf, Match, "", , , vbBinaryCompare)
    Next
  End If
End With
  DOBK = Buf
End Function

こんにちは。

例えば、

半角カタカナ+全角 というようになっているのでしたら、

=MID(A1,MATCH(TRUE,INDEX(CODE(MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1))>256,,),0),255)

このような数式で、削除することが可能です。(ただし、数字やアルファベットも含みます。それを、半角カタカナでくくることも可能ですが、数式が長くなりすぎます。)

しかし、それ以上に、半角カタカナと全角とが混在していたり、英数と混在していて、半角カタカナだけを削除するのは、上記のような数式ではうまくいきませ...続きを読む

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング