• ベストアンサー

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の改行マークか何らかのスペースの跡らしく、検索や置換では引っかかりません。

質問者が選んだベストアンサー

  • ベストアンサー
  • BLUEPIXY
  • ベストアンサー率50% (3003/5914)
回答No.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>") などとすればいいでしょう。

mskhas
質問者

お礼

ありがとうございました。コードとして13が表示されましたので、SUBSTITUTE関数を使って取り除くことができました。 助かりました。本当にありがとうございました。

その他の回答 (5)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.5

こんにちは。 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 '-------------------------------------------

回答No.4

例えば、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) でいけると思います。

回答No.3

もっと簡単にできました。 =IF(ISNA(MATCH("*男*",A1,0)),"女","男")

  • BLUEPIXY
  • ベストアンサー率50% (3003/5914)
回答No.2

原因は、 >Cells.Find で、検索する範囲をA列に限定していないのが1つの原因だと思います。 マクロによらないでも、単にB列に =IF(COUNTIF(A1,"*男*"),"男",IF(COUNTIF(A1,"*女*"),"女","")) とするだけでいいと思います。

mskhas
質問者

補足

ありがとうございました。うまく動作しました。 実はこの後にもデータを抜き出さなくてはいけない作業が山済みになっています。 それは、B2セルには    「指導内容は○○/△△・・・・対象は○○」     B3セルには    「指導内容は△△/◇◇/○○・・対象は△△」 というような情報から 「指導内容は○○/△△」のみや 「対象は△△」を取り出すのですが MIDやFIND関数で取り出すことはできると考えています。 問題は「・・」です。 先ほども記述しましたが、「・・」は文字でなく 改行かスペースの跡らしく検索や置換ができません。 セルによってその数もばらばらなので 「指導内容は○○/△△・・・・」 「指導内容は○○/△△・・」 と「・・」が残ってしまいます。 どうすればよいのでしょうか。 ぜひよろしくお願いします

回答No.1

Cell関数ではダメですか? Cell B1に以下の関数を入力してください。 =IF(ISNA(VLOOKUP("*男*",A1,1,FALSE)),IF(ISNA(VLOOKUP("*女*",A1,1,FALSE)),"?","女"),"男") で、Cell B1を選択し、A列の最後のデータの行まで、ずずーっとドラッグ(要するにコピーですね)。 すると、B列に「男」「女」、どちらもなければ「?」が表示されると思います。 註:「ツール」-> 「アドイン」メニューで、「分析ツール」を選択しておいてください。

関連するQ&A

専門家に質問してみよう