- ベストアンサー
EXCEL VBA マクロがうまく動作しません
いつもお世話になっております。 EXCELのマクロについて教えてください。 シートに 男 ・男・ 女・ ・・男 ・男・・ ・女 上記のように1つのセルに「・男」「女」 など文字だけでなく「・」がバラバラに入った データが列方向に400件あります 次の列に、「男」「女」だけの文字だけを抜き取りたいので、下のようなマクロを組みました。 Sub 性別取り出し() Range("a2").Select Do Until retu = 2 retu = ActiveCell.Column Cells.Find(What:="男", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _ , MatchByte:=False, SearchFormat:=False).Activate Cells.FindNext(After:=ActiveCell).Activate ActiveCell.Offset(0, 2).Activate ActiveCell.Value = "男" ActiveCell.End(xlToLeft).Activate Loop MsgBox counter & "回ループしました" End Sub A列 B列 男 |男 ・男・ |男 女・ | ・・男 |男 ・男・・|男 ・女 | というような結果を期待したのですが 実際は A列 B列 男 |男 | 男 ・男・ | | 女・ | | ・・男 |男 | 男 ・男・・| | ・女 | | のように、B列の結果が飛び飛びになったり C列以降に男の文字が入ったり 永遠にループを続けたりします。 いろいろ試しましたが、うまくいきません どうしたら良いか教えてください。 よろしくお願いします。 ちなみにデータの「・」はALT+ENTERの改行マークか何らかのスペースの跡らしく、検索や置換では引っかかりません。
- みんなの回答 (6)
- 専門家の回答
質問者が選んだベストアンサー
>問題は「・・」です。 まずは、そのゴミがなにであるか調べましょう。 列を挿入して、作業列を作り A,B,C データ(A1),=MID($A$1,ROW(),1),=CODE(MID($A$1,ROW(),1)) のようにして、B,Cを下にコピーすると それぞれの文字がBに、その文字のコードがCに表示されます。 例えば、ALT+ENTERで改行されている場合 コードとして 10 が表示されます。(文字としては表示されません) 件のデータのコードがわかれば =SUBSTITUTE(A1,CHAR(10),"") のようにして、件のデータ(この例の場合は、コード10)を取り除くことができます。 文字の区切りのマークとして残しておきたい場合は =SUBSTITUTE(A1,CHAR(10),"<BR>") などとすればいいでしょう。
その他の回答 (5)
- Wendy02
- ベストアンサー率57% (3570/6232)
こんにちは。 Findメソッドは、決まったアルゴリズムを使います。それ以外の方法ではうまくいかないことが多いです。一応、"女"の文字は、男の隣のセルに出すようにしました。 いっしょのセルなら、サブルーチンの中の .Offset(, i + 1).Value は、 .Offset(, 1).Value にしてください。 '------------------------------------------- Sub PickUpAtCells() Dim c As Range Dim myFadd As String Dim rng As Range Dim i As Integer Dim Genders(1) As String Genders(0) = "男" Genders(1) = "女" Set rng = ActiveSheet.Columns(1) Application.ScreenUpdating = False For i = 0 To 1 Set c = rng.Find( _ What:="*" & Genders(i) & "*", _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlNext) If Not c Is Nothing Then myFadd = c.Address Do s_PickupCells c, Genders(i), i 'サブルーチンへ Set c = rng.FindNext(c) Loop Until c Is Nothing Or c.Address = myFadd End If Next i Application.ScreenUpdating = True End Sub Sub s_PickupCells(myRng As Range, SearchWord As String, i As Integer) 'サブルーチン Dim number As Integer number = InStr(myRng, SearchWord) If number > 0 Then myRng.Offset(, i + 1).Value = Mid$(myRng.Value, number, 1) End If End Sub '-------------------------------------------
- shinchan_k
- ベストアンサー率37% (16/43)
例えば、B1に=MID(A1,IF(ISERROR(FIND("男",A1)),0,FIND("男",A1))+IF(ISERROR(FIND("女",A1)),0,FIND("女",A1)),1) としてはいかがでしょう。ただし、1つのセルに男or女が2文字以上あるとだめですが・・・ 男だけ表示するのなら =MID(A1,IF(ISERROR(FIND("男",A1)),0,FIND("男",A1)),1) でいけると思います。
- kenken_ken
- ベストアンサー率33% (20/59)
もっと簡単にできました。 =IF(ISNA(MATCH("*男*",A1,0)),"女","男")
- BLUEPIXY
- ベストアンサー率50% (3003/5914)
原因は、 >Cells.Find で、検索する範囲をA列に限定していないのが1つの原因だと思います。 マクロによらないでも、単にB列に =IF(COUNTIF(A1,"*男*"),"男",IF(COUNTIF(A1,"*女*"),"女","")) とするだけでいいと思います。
補足
ありがとうございました。うまく動作しました。 実はこの後にもデータを抜き出さなくてはいけない作業が山済みになっています。 それは、B2セルには 「指導内容は○○/△△・・・・対象は○○」 B3セルには 「指導内容は△△/◇◇/○○・・対象は△△」 というような情報から 「指導内容は○○/△△」のみや 「対象は△△」を取り出すのですが MIDやFIND関数で取り出すことはできると考えています。 問題は「・・」です。 先ほども記述しましたが、「・・」は文字でなく 改行かスペースの跡らしく検索や置換ができません。 セルによってその数もばらばらなので 「指導内容は○○/△△・・・・」 「指導内容は○○/△△・・」 と「・・」が残ってしまいます。 どうすればよいのでしょうか。 ぜひよろしくお願いします
- kenken_ken
- ベストアンサー率33% (20/59)
Cell関数ではダメですか? Cell B1に以下の関数を入力してください。 =IF(ISNA(VLOOKUP("*男*",A1,1,FALSE)),IF(ISNA(VLOOKUP("*女*",A1,1,FALSE)),"?","女"),"男") で、Cell B1を選択し、A列の最後のデータの行まで、ずずーっとドラッグ(要するにコピーですね)。 すると、B列に「男」「女」、どちらもなければ「?」が表示されると思います。 註:「ツール」-> 「アドイン」メニューで、「分析ツール」を選択しておいてください。
お礼
ありがとうございました。コードとして13が表示されましたので、SUBSTITUTE関数を使って取り除くことができました。 助かりました。本当にありがとうございました。