Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1571 / 13645 ツリー ←次へ | 前へ→

【73431】含まれる文字に応じ別の列にフラグを立てるには にしもり 13/1/9(水) 17:20 質問[未読]
【73432】Re:含まれる文字に応じ別の列にフラグを立... UO3 13/1/9(水) 21:28 発言[未読]
【73433】Re:含まれる文字に応じ別の列にフラグを立... にしもり 13/1/10(木) 10:06 質問[未読]
【73436】Re:含まれる文字に応じ別の列にフラグを立... UO3 13/1/10(木) 12:56 発言[未読]
【73437】Re:含まれる文字に応じ別の列にフラグを立... にしもり 13/1/10(木) 15:31 質問[未読]
【73438】Re:含まれる文字に応じ別の列にフラグを立... UO3 13/1/10(木) 15:51 発言[未読]
【73439】Re:含まれる文字に応じ別の列にフラグを立... にしもり 13/1/10(木) 16:21 お礼[未読]

【73431】含まれる文字に応じ別の列にフラグを立て...
質問  にしもり  - 13/1/9(水) 17:20 -

引用なし
パスワード
   こんにちは。

A列にタイトル「製品名」で文字列が入っていて、
B列にタイトル「日付」で文字列が入っていて、
C列にタイトル「通し番号」で文字列が入っていて、
D列にタイトル「客室タイプ」で文字列が入っていて、
E列にタイトル「質問内容」で文字列が入っていて、
F列にタイトル「sea」でなにも入っていず、
G列にタイトル「mount」でなにも入っていません。


いま、E列2行目をポイントして
文字列に海が含まれていたらF列2行目に"1"を
文字列に山が含まれていたらG列2行目に"1"を

つぎに、E列3行目をポイントして
文字列に海が含まれていたらF列3行目に"1"を
文字列に山が含まれていたらG列3行目に"1"を、、、、

入れていきたいです。

ここまで記述しましたが行き詰まりました。
どうすればよいかどなたか御教授いただけませんでしょうか。

↓↓

Sub Type1()
 Dim r As Range
 Dim v
 Dim i As Long
 Dim j As Long
  Set r = Sheets(1).Cells(1).CurrentRegion
  v = r.Value
  With CreateObject("Forms.ComboBox.1")
    .List = v
    j = 5
    For i = .ListCount - 1 To 2 Step -1
      If .List(i, j) = "*海*" Then
        j = j + 1
        .List(i, j) = "1"
        j = j - 1
        If .List(i, j) = "*山*" Then
          j = j + 2
          .List(i, j) = "1"
          j = j - 2
          .RemoveItem i
        End If
      End If
    Next
    r.ClearContents
    r.Resize(.ListCount, 13).Value = .List
  End With
  Beep
End Sub

【73432】Re:含まれる文字に応じ別の列にフラグを...
発言  UO3  - 13/1/9(水) 21:28 -

引用なし
パスワード
   ▼にしもり さん:

文章で書いておられることとコードで実行しておられることが
いささかマッチしていないような気がして、だからこちらが勘違いしているんだろうなと
コードをアップするのを躊躇していましたが、レスがつかないようなので
「たたかれ台」として。

Sub Sample()
  Dim v As Variant
  Dim i As Long
  
  With Sheets(1)
    v = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Offset(, 4).Value
    ReDim Preserve v(1 To UBound(v, 1), 1 To 3)
    For i = 1 To UBound(v, 1)
      If v(i, 1) Like "*海*" Then v(i, 2) = 1
      If v(i, 1) Like "*山*" Then v(i, 3) = 1
    Next
    .Range("E2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
  End With
    
End Sub

【73433】Re:含まれる文字に応じ別の列にフラグを...
質問  にしもり  - 13/1/10(木) 10:06 -

引用なし
パスワード
   ▼UO3 さん:

ありがとうございます。
説明べたで申しわけございません。
また、わたくしは記述に関していまだに見よう見まねの域を出ません。
お許しください。

実は、検索したいのは海、山だけではなくてもっとあります。
なので下記のようにしてみました。

Sub Sample()
  Dim v As Variant
  Dim i As Long
 
  With Sheets(1)
'    v = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Offset(, 4).Value
     v = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Offset(, 15).Value
    ReDim Preserve v(1 To UBound(v, 1), 1 To 3)
    For i = 1 To UBound(v, 1)
      If v(i, 1) Like "*海*" Then v(i, 2) = 1
      If v(i, 1) Like "*山*" Then v(i, 3) = 1
      If v(i, 1) Like "*川*" Then v(i, 4) = 1
      If v(i, 1) Like "*池*" Then v(i, 5) = 1
      If v(i, 1) Like "*森*" Then v(i, 6) = 1
      If v(i, 1) Like "*林*" Then v(i, 7) = 1
      If v(i, 1) Like "*木*" Then v(i, 8) = 1
      If v(i, 1) Like "*空*" Then v(i, 9) = 1
      If v(i, 1) Like "*星*" Then v(i, 10) = 1
      If v(i, 1) Like "*月*" Then v(i, 11) = 1
      If v(i, 1) Like "*光*" Then v(i, 12) = 1
      If v(i, 1) Like "*夢*" Then v(i, 13) = 1
      If v(i, 1) Like "*幻*" Then v(i, 14) = 1
      If v(i, 1) Like "*音*" Then v(i, 15) = 1
      If v(i, 1) Like "*波*" Then v(i, 16) = 1
  
    Next
    .Range("E2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
  End With
  
End Sub


するとE2以下が残っていてほしいのに消えてしまい、
F2より右に全然フラグが立ちません。
どうすればよろしいでしょうか。

【73436】Re:含まれる文字に応じ別の列にフラグを...
発言  UO3  - 13/1/10(木) 12:56 -

引用なし
パスワード
   ▼にしもり さん:

こんにちは

v = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Offset(, 4).Value

これを

v = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Offset(, 15).Value

このように直されましたね。
もともとの
v = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Offset(, 4).Value
この意味は、
A2からA列最終データまでの1列の領域の4つ右の領域、つまりE列の領域です。
そのE列の領域を取り込んだ●行1列の配列に対して
ReDim Preserve v(1 To UBound(v, 1), 1 To 3) で、列を2つ追加。(F,G列用)
その追加した2列目、3列目に、1列目の値(元のE列の値)を参照しながら
1 をセットしていって、最後に、この3列分の配列を E2:G● までに、どさっと上書き。
こんな処理です。

ところが

v = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Offset(, 15).Value

これは E列の領域ではなく、A列から15右、つまり、P列の領域になります。
おそらく、そこは空白でしょうから海でも山でもない。したがって、2列目、3列目に1がたたない。
で、その結果の3列(1列目は空白)を、E2:G●にどさっと上書きしますのですべて空白になります。

ところで、これだけ対象が増えたということを考えますと、別の方法(正規表現といわれるもの等)が
よろしいかとは思いますが、にしもりさんにとっては、きわめてわかりにくいコードになると
思われますので、現在の処理構成のままにしてあります。

Sub Sample2()
  Dim v As Variant
  Dim i As Long

  With Sheets(1)
    v = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Offset(, 4).Value
    ReDim Preserve v(1 To UBound(v, 1), 1 To 16)  '★
    For i = 1 To UBound(v, 1)
      If v(i, 1) Like "*海*" Then v(i, 2) = 1
      If v(i, 1) Like "*山*" Then v(i, 3) = 1
      If v(i, 1) Like "*川*" Then v(i, 4) = 1
      If v(i, 1) Like "*池*" Then v(i, 5) = 1
      If v(i, 1) Like "*森*" Then v(i, 6) = 1
      If v(i, 1) Like "*林*" Then v(i, 7) = 1
      If v(i, 1) Like "*木*" Then v(i, 8) = 1
      If v(i, 1) Like "*空*" Then v(i, 9) = 1
      If v(i, 1) Like "*星*" Then v(i, 10) = 1
      If v(i, 1) Like "*月*" Then v(i, 11) = 1
      If v(i, 1) Like "*光*" Then v(i, 12) = 1
      If v(i, 1) Like "*夢*" Then v(i, 13) = 1
      If v(i, 1) Like "*幻*" Then v(i, 14) = 1
      If v(i, 1) Like "*音*" Then v(i, 15) = 1
      If v(i, 1) Like "*波*" Then v(i, 16) = 1
 
    Next
    .Range("E2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
  End With
 
End Sub

【73437】Re:含まれる文字に応じ別の列にフラグを...
質問  にしもり  - 13/1/10(木) 15:31 -

引用なし
パスワード
   ▼UO3 さん:
ありがとうざいます。
希望通り走りました。
また、詳細に解説までいただきまことにありがとうございます。
自分の解釈違いが理解できました。

正規表現でなくとも十分でございます。
仰るように混乱すると思いますので。

あと、すみませんが
Like 演算子とワイルドカードと、Or や Andは併用できないのでしょうか。
ネットで検索してもよくわかりませんでした。
コンパイルはできるのですがabendします。


Sub Sample2()
  Dim v As Variant
  Dim i As Long

  With Sheets(1)
    v = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Offset(, 4).Value
    ReDim Preserve v(1 To UBound(v, 1), 1 To 16)  '★
    For i = 1 To UBound(v, 1)
      If v(i, 1) Like "*海*" And "*潮*" Then v(i, 2) = 1 '<=abnormal end します
      If v(i, 1) Like "*山*" Or "*峰*" Then v(i, 3) = 1 '<=これもまたabnormal end します
      If v(i, 1) Like "*川*" Then v(i, 4) = 1
      If v(i, 1) Like "*池*" Then v(i, 5) = 1
      If v(i, 1) Like "*森*" Then v(i, 6) = 1
      If v(i, 1) Like "*林*" Then v(i, 7) = 1
      If v(i, 1) Like "*木*" Then v(i, 8) = 1
      If v(i, 1) Like "*空*" Then v(i, 9) = 1
      If v(i, 1) Like "*星*" Then v(i, 10) = 1
      If v(i, 1) Like "*月*" Then v(i, 11) = 1
      If v(i, 1) Like "*光*" Then v(i, 12) = 1
      If v(i, 1) Like "*夢*" Then v(i, 13) = 1
      If v(i, 1) Like "*幻*" Then v(i, 14) = 1
      If v(i, 1) Like "*音*" Then v(i, 15) = 1
      If v(i, 1) Like "*波*" Then v(i, 16) = 1
 
    Next
    .Range("E2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
  End With
 
End Sub

【73438】Re:含まれる文字に応じ別の列にフラグを...
発言  UO3  - 13/1/10(木) 15:51 -

引用なし
パスワード
   ▼にしもり さん:

>Like 演算子とワイルドカードと、Or や Andは併用できないのでしょうか。
>ネットで検索してもよくわかりませんでした。
>コンパイルはできるのですがabendします。

できますよ。
ただし、 Like で、できるかどうかということではなく If文で、どう書くかということなんです。

たとえば以下。

Sub Test1()
  Dim s As String
  
  s = "abcd海xyz"
  
  If s Like "*海*" Or s Like "*山*" Then
    MsgBox "海または山です"
  Else
    MsgBox "海でも山でもありません"
  End If
  
  s = "abcd川xyz"
  
  If s Like "*海*" Or s Like "*山*" Then
    MsgBox "海または山です"
  Else
    MsgBox "海でも山でもありません"
  End If
  
End Sub

Sub Test2()
  Dim s As String
  
  s = "abcd海xyz山123"
  
  If s Like "*海*" And s Like "*山*" Then
    MsgBox "海かつ山です"
  Else
    MsgBox "海かつ山ではありません"
  End If
  
  s = "abcd川xyz"
  
  If s Like "*海*" And s Like "*山*" Then
    MsgBox "海かつ山です"
  Else
    MsgBox "海かつ山ではありません"
  End If
  
End Sub

>      If v(i, 1) Like "*海*" And "*潮*" Then v(i, 2) = 1 '<=abnormal end します
>      If v(i, 1) Like "*山*" Or "*峰*" Then v(i, 3) = 1 '<=これもまたabnormal end します

"*海*" And "*潮*"  や  "*山*" Or "*峰*" と記述すると、いわゆる【論理演算】としての
AND や OR を実行しようとします。
VBAの場合、文字列同士の 論理演算は不可能です。

【73439】Re:含まれる文字に応じ別の列にフラグを...
お礼  にしもり  - 13/1/10(木) 16:21 -

引用なし
パスワード
   ▼UO3 さん:
>VBAの場合、文字列同士の 論理演算は不可能です。
わかりました。
E列に入っているのは結構長い文字列なので手を加えるのは止めておこうとおもいます。
この度はありがとうございました。
深く感謝いたします。

1571 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free