条件が合わないデータの左のセルに追記する為には？

質問

色々と調べましたが、どうしても分からなく、質問させていただきます。
3000件程のデータが「1」という名称のシートに収まっています。
自分の部署と他部署のデータが混在しており、その中から他部署のデータを件名から抽出し、別シートへ移動させたいと考えております。
件名の頭文字には、自分の部署の場合、「A」「B」「C」が必ず付き、他部署のデータにはABCがまったく付かない状態です。
例：自分の部署の場合→　A今日の献立
他部署の場合→　今日の献立
他部署の件名データの頭文字に「Z」という文字を追加しようと思い、まず、件名が入力されているE列の右に新たな列（E列)を追加し、そこへ該当する件名には「Z」を入力、E列と件名のF列を一緒にしようと試行錯誤したのですが、「Z」を入力する為のマクロがどうしても出来なくて苦戦しております。
ご教授お願い致します。

Sub Macro1()
Worksheets("1").Select
Columns("E").Insert shift:=xlToLeft
Range("F2").Activate
Dim strName As Long
For strName = Cells(Rows.Count, 6).End(xlUp).Row To 2 Step -1
With Cells(strName, 6)

Select Case strName
Case strName Like "A"
activecells.Offset(0, -1).Value = ""
Case strName Like "B"
activecells.Offset(0, -1).Value = ""
Case strName Like "C"
activecells.Offset(0, -1).Value = ""
Case Else
activecells.Offset(0, -1).Value = "Z"
End Select
End With
Next strName
End Sub

回答No.1

redfox63 · ベストアンサー

ABCが先頭にあるならセルデータの左から1文字を検査すればいいように思います

for nLine = Cells( Rows.Count, 6 ).End(xlUp).Row to 2 Step -1
　　if InStr( "ABC", Left(Cells( nLIne, 6 ),1 ) > 0 then
　　　　Cells(nLine,5).Value = ""
　　else
　　　　Cells(nLine,5).Value = "Z"
　　end if
Next
といった具合でしょう

お礼

ご回答誠にありがとうございました。
早速職場で試しました。
スムーズに進み、とても感激致しました。
2ヶ月悩んでいたので、本当に嬉しい限りです。
ありがとうございました。

回答No.3

pulsa

Zの方はNo.1さんが答えてるので
>その中から他部署のデータを件名から抽出し、別シートへ移動
の方

　　Dim iCnt As Integer
　　Dim jCnt As Integer
　　Sheets("1").Rows(1).Copy Sheets("別シート").Cells(1, 1) '見出し

　　jCnt = 1
　　For iCnt = 2 To Sheets("1").Range("E1").CurrentRegion.Rows.Count
　　　　If Sheets("1").Cells(iCnt, 6) Like "[!A-C]*" Then’ワイルドカード
　　　　'If InStr( "ABC", Left(Cells( iCnt, 6 ),1 )) = 0 then’InStr(No.1さんのコピペ　すまぬ)
　　　　　　jCnt = jCnt + 1
　　　　　　Sheets("1").Rows(iCnt).Copy Sheets("別シート").Cells(jCnt, 1)
　　　　End If
　　Next iCnt

解説すると、俺のコードの方（Like "[!A-C]*"）は検索セルがA～Cで始まる文字列かどうかで判定してる（!は打消しなので、じゃない　になる）
No.1さんの方は、検索セルの1文字目を"ABC"のどこかから始まっているか（無ければ0）で判定してます
どっちがどうって事ではなくて、必要に応じて使い分けれる事が重要で、ついでに言うと、やり方はこれだけではありません
or　や　And でIF文を連結するんでも良いでしょうし、お使いになっているSelect Case だと
　　Select Case Sheets("1").Cells(iCnt, 6)
　　　　Case "A*", "B*", "C*"　'False
　　　　Case Else 'True
てな感じもなかなかキレイです

ついでに、Forは
Dim strName
For Each strName In Range("E:E")
　　MsgBox　strName
Next strName
ってやると、また素敵な事が起こります

もうちょいですよ

お礼

ご回答ありがとうございます。
別シートへの移動の仕方をおしえていただき、ありがとうございます。
是非参考させていただきます。
まだまだ未熟なもので、これだけ色々ご提示出来るなんで凄いと感心しきりです。
ありがとうございました。

回答No.2

bin-chan

そもそも、case文の like には　ワイルドカードが必要なのでは？

誤）Case strName Like "A"

正）Case strName Like "A*"

お礼

ご指摘ありがとうございます。
確かに*が抜けておりました…
正確に提示できず情けない限りです。