[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Select Case TrueとLikeを使用したvba』（Select Case）
Select Case TrueでLikeを使い文字を変換したい
別の方法を使用した方が良いかも知れませんが。
下手に他の方法で行っても他に活用できる知識がないので
Select Case TrueのLikeを使い行いたい
上記で言うと「福山」を含む文字の場合は、「福山通運」に変換
A列に文字がありB列に変換後の文字を表示したい
下記はネットで見たのに無理やり付けたんですが、
これだと同じセルしか指定できないのでとんでもない量を記入しないでできない
Sub SelectCaseとLike()
Dim addr As String
addr = ActiveCell.Value
Select Case True
Case addr Like "*セン*"
Range("B1") = "センコー"
Case Else
Select Case True
Case addr Like "*福山*"
Range("B1") = "福山通運"
Case Else
Range("B1") = Range("A1")
End Select
End Select
End Sub
SelectCaseとLikeを使用した方法にて紹介をお願いします。
＜ 使用 Excel：Microsoft365、使用 OS：Windows11 ＞
Public Sub Test()
Dim r As Range, c As Range
Dim addr As String
Set r = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
For Each c In r
addr = c.Value
Select Case True
Case addr Like "*セン*"
c.Offset(, 1) = "センコー"
Case addr Like "*福山*"
c.Offset(, 1) = "福山通運"
Case Else
c.Offset(, 1) = c
End Select
Next
End Sub
（hatena） 2023/06/01(木) 13:24:10
cは何を表しているのでしょうか？
（Select Case） 2023/06/01(木) 14:11:07
まず、 Set r = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)) で r にA列の最終行までのセル範囲を代入します。
For Each c In r で上記のセル範囲の先頭から1セルずつ取り出してcに格納します。それを最後まで繰り返します。
addr = c.Value で取り出したセル(c)の値をaddr変数に代入します。
それを Select Case文で比較して該当すれば右隣のセルに代入します。
c.Offset(, 1) はセルの右隣りのセルになります。(つまりB列のセル) （hatena） 2023/06/01(木) 14:22:46
For Each c In r で上記のセル範囲の先頭から1セルずつ取り出してcに格納します。それを最後まで繰り返します これ以外は理解できました。
セル範囲の先頭とは何ですか？
1セルずつ取り出す？
これって、
Set r = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
addr = r.Value
で For Each c In r を無くすことはできないんですか？
いまいち、https://excel-ubara.com/excelvba1/EXCELVBA359.htmlを見たんですが…
すみません、理解力なくて...
（Select Case） 2023/06/01(木) 15:15:19
例えば、A1からA3まで入力してあって、それらの3セル分の処理をする場合、 Forなどのループ処理を使わないと、
addr = Cells(1,1).Value
Select Case True
Case addr Like "*セン*"
Cells(1,2) = "センコー"
Case addr Like "*福山*"
Cells(1,2) = "福山通運"
Case Else
Cells(1, 2) = addr
End Select
addr = Cells(2, 1).Value
Select Case True
Case addr Like "*セン*"
Cells(2, 2) = "センコー"
Case addr Like "*福山*"
Cells(2, 2) = "福山通運"
Case Else
Cells(2, 2) = addr
End Select
addr = Cells(3,1).Value
Select Case True
Case addr Like "*セン*"
Cells(3, 2) = "センコー"
Case addr Like "*福山*"
Cells(3, 2) = "福山通運"
Case Else
Cells(3, 2) = addr
End Select
と同じことを３回繰り返し記述する必要があります。これは理解できますよね。 ３回ぐらいならまだいいですが、これが何十、何百もあったら大変ですよね。
この繰り返しをまとめて記述する手段がForによる繰り返し処理になります。
先の回答で使用したFor Each 以外にも For...Next のループ処理もあります。 それを使うと下記のようなコードになります。
Public Sub Test()
Dim i As Long
Dim addr As String
For i = 1 to Cells(Rows.Count, 1).End(xlUp).Row
addr = Cells(i, 1)
Select Case True
Case addr Like "*セン*"
Cells(i, 2) = "センコー"
Case addr Like "*福山*"
Cells(i, 2) = "福山通運"
Case Else
Cells(i, 2) = addr
End Select
Next
End Sub
こちらの方が繰り返し処理が初めての人にはわかりやすいかもしれませんね。
このような繰り返し処理については解説ページがたくさんあるので、それをみて研究してください。 （hatena） 2023/06/01(木) 17:35:03
■１
本件の場合ループ処理で１セルずつ判定＆処理せずとも↓のような【一括置換】する処理でも同じ結果が得られると思います。
Sub 研究用1()
With ActiveSheet
With .Range("A1", Cells(Rows.Count, 1).End(xlUp))
.Copy .Offset(, 1)
.Offset(, 1).Replace "福山*", "福山通運", LookAt:=xlWhole
.Offset(, 1).Replace "佐川*", "佐川急便", LookAt:=xlWhole
.Offset(, 1).Replace "西濃*", "西濃運輸", LookAt:=xlWhole
.Offset(, 1).Replace "スーパー*", "スーパーＥＸ", LookAt:=xlWhole
.Offset(, 1).Replace "ＥＸ*", "スーパーＥＸ", LookAt:=xlWhole
.Offset(, 1).Replace "四国西濃*", "西濃運輸", LookAt:=xlWhole
End With
End With
End Sub
■２
そのうえで、キーワードを入れ替えながら"繰り返す"という考え方をすると上記は↓のように【配列】を使って表現してもＯＫです。
Sub 研究用2()
Dim i As Long
Dim 置換前 As Variant, 置換後 As Variant
置換前 = Array("福山*", "佐川*", "西濃*", "スーパー*", "ＥＸ*", "四国西濃*")
置換後 = Split("福山通運,佐川急便,西濃運輸,スーパーＥＸ,スーパーＥＸ,西濃運輸", ",")
With ActiveSheet
With .Range("A1", Cells(Rows.Count, 1).End(xlUp))
.Copy .Offset(, 1)
For i = 0 To UBound(置換前) Step 1
.Offset(, 1).Replace 置換前(i), 置換後(i), LookAt:=xlWhole
Next i
End With
End With
End Sub
とか
Sub 研究用3()
Dim i As Long
Dim 二次元配列(5, 1) As String
二次元配列(0, 0) = "福山*"
二次元配列(0, 1) = "福山通運"
二次元配列(1, 0) = "佐川*"
二次元配列(1, 1) = "佐川急便"
二次元配列(2, 0) = "西濃*"
二次元配列(2, 1) = "西濃運輸"
二次元配列(3, 0) = "スーパー*"
二次元配列(3, 1) = "スーパーＥＸ"
二次元配列(4, 0) = "ＥＸ*"
二次元配列(4, 1) = "スーパーＥＸ"
二次元配列(5, 0) = "四国西濃*"
二次元配列(5, 1) = "西濃運輸"
With ActiveSheet
With .Range("A1", Cells(Rows.Count, 1).End(xlUp))
.Copy .Offset(, 1)
For i = 0 To 5 Step 1
.Offset(, 1).Replace 二次元配列(i, 0), 二次元配列(i, 1), LookAt:=xlWhole
Next i
End With
End With
End Sub
■３
さらに、配列はよくわからないのでちょっと・・・という場合でも例えば↓のようにリストを用意しておき
【置換リスト】シート
___A____ _____B______
1 置換前 置換後
2 福山* 福山通運
3 佐川* 佐川急便
4 西濃* 西濃運輸
5 スーパー* スーパーＥＸ
6 ＥＸ* スーパーＥＸ
7 四国西濃* 西濃運輸
↓のようにするのも有効だと思います。
Sub 研究用4()
Dim リスト範囲 As Range
Dim i As Long
Set リスト範囲 = Worksheets("置換リスト").Range("A2:B7")
With ActiveSheet
With .Range("A1", Cells(Rows.Count, 1).End(xlUp))
.Copy .Offset(, 1)
For i = 1 To リスト範囲.Rows.Count
.Offset(, 1).Replace リスト範囲.Cells(i, 1).Value , リスト範囲.Cells(i, 2).Value, LookAt:=xlWhole
Next i
End With
End With
End Sub
■４
いずれせよ、データ件数にもよるとはおもいますが、データ量が増えれば増えるほど1セルずつ処理するより一括して置換の方が処理速度の面で軍配が上がると思いますから、興味があれば余力のある時に研究して引き出しを増やしておくとよいと思います。
（もこな２） 2023/06/01(木) 22:39:21
研究用1と研究用2は実際に実行してみて理解できたのですが
まだまだ、自分では作れないですが
研究用4VLOOCKに似た考え方ですよね？
ワイルドカードが使えるんですね！？
これは、自分でできなかったので最初考えたのですが
シートが多い資料の為、あまりシートを増やしたくなくて今回相談をしました。
研究用3は理解が出来ない感じです。
LookAt自体初めて見ましたが
xlPartにしないでxlWholeにする理由は何なのでしょうか？
今回の質問に対しては完全一致ではなく、部分一致なイメージなんですが…
まぁ、そこ以外も理解できていないですが
二次元配列(0, 0)
二次元配列(1, 0)
って
For i = 0 To 5 Step 1 で１つの塊にしてリピートするイメージですか？
（Select Case） 2023/06/05(月) 11:42:56
研究用1が処理が速い理由は分かるんですが
研究用2は、1と違い１個づつファイルを見ているではないのでしょうか？
FOR NEXTを使用しているので…
まだ、CASEも含めて分岐系は頭で理解できてないので
教科書を見ながらの次元、それでも頭を悩ませてる感じです。
Excelの置換って感じで空白セルに半角スペースを入れたいと思って研究用に入れ込んだんですが
できませんでした、空白セルに半角スペースを入れるのはまた考え方が違うのでしょうか？
（Select Case） 2023/06/05(月) 11:53:43
Sub 研究用1()
With ActiveSheet
With .Range("A1", Cells(Rows.Count, 1).End(xlUp))
.Copy .Offset(, 1)
.Offset(, 1).Replace "福山*", "福山通運", LookAt:=xlWhole
.Offset(, 1).Replace "佐川*", "佐川急便", LookAt:=xlWhole
.Offset(, 1).Replace "西濃*", "西濃運輸", LookAt:=xlWhole
.Offset(, 1).Replace "スーパー*", "スーパーＥＸ", LookAt:=xlWhole
.Offset(, 1).Replace "ＥＸ*", "スーパーＥＸ", LookAt:=xlWhole
.Offset(, 1).Replace "四国西濃*", "西濃運輸", LookAt:=xlWhole
End With
End With
End Sub
これを３か所に行う場合
AS3を対象にするしてA列にコピー後置換
AT3を対象にするしてB列にコピー後置換
AU3を対象にするしてC列にコピー後置換
と三回行う場合は、上記を三回行うしか方法はないでしょうか？
別にカッコいい方法はありますか？
（Select Case） 2023/06/05(月) 12:29:57
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.