Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1156 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【75979】A列B列シートの文字をみて別シートのC列を置換 daisuke 14/8/14(木) 23:43 質問[未読]
【75980】Re:A列B列シートの文字をみて別シートのC列... kanabun 14/8/15(金) 0:08 発言[未読]
【75981】Re:A列B列シートの文字をみて別シートのC列... γ 14/8/15(金) 8:31 発言[未読]
【75982】Re:A列B列シートの文字をみて別シートのC列... daisuke 14/8/15(金) 13:03 お礼[未読]
【75984】Re:A列B列シートの文字をみて別シートのC列... kanabun 14/8/15(金) 14:52 発言[未読]
【75985】Re:A列B列シートの文字をみて別シートのC列... daisuke 14/8/15(金) 15:37 質問[未読]
【75987】Re:A列B列シートの文字をみて別シートのC列... kanabun 14/8/15(金) 17:39 発言[未読]
【75991】Re:A列B列シートの文字をみて別シートのC列... daisuke 14/8/15(金) 18:04 質問[未読]
【75994】Re:A列B列シートの文字をみて別シートのC列... daisuke 14/8/15(金) 18:25 お礼[未読]
【75983】Re:A列B列シートの文字をみて別シートのC列... daisuke 14/8/15(金) 13:10 お礼[未読]
【75986】Re:A列B列シートの文字をみて別シートのC列... γ 14/8/15(金) 17:00 発言[未読]
【75988】Re:A列B列シートの文字をみて別シートのC列... daisuke 14/8/15(金) 17:39 質問[未読]
【75989】Re:A列B列シートの文字をみて別シートのC列... γ 14/8/15(金) 17:48 発言[未読]
【75990】Re:A列B列シートの文字をみて別シートのC列... daisuke 14/8/15(金) 18:01 質問[未読]
【75992】Re:A列B列シートの文字をみて別シートのC列... γ 14/8/15(金) 18:13 発言[未読]
【75993】Re:A列B列シートの文字をみて別シートのC列... daisuke 14/8/15(金) 18:23 お礼[未読]
【75979】A列B列シートの文字をみて別シートのC列...
質問  daisuke  - 14/8/14(木) 23:43 -
引用なし
パスワード
   シート１のA列に検索対象の文字とB列に置換対象の文字が
あります。シート１のA列の文字があったらシート２のC列にある
文字をシート１のB列の文字に置換し文字に赤色をつけたいです。
いままで手作業で置換していましたがマクロで効率化したいです。
どなたかご教授ください。よろしくお願いします。

シート１（A列検索対象とB列置換文字）
A列　　B列
R　　りんご
M　　みかん
.　　　.
.　　　.
.　　　.
S　　すいか

シート２
A列　　　B列　　C列
2014年　１月　　M
2014年　２月　　S
.　　 　 .　　　・
.　　 　 .　　　・
.　　 　 .　　　・
2014年　３月　　R

マクロで置換後
シート２
A列　　　B列　　C列
2014年　１月　　みかん(文字赤）
2014年　２月　　すいか(文字赤）
.　　 　 .　　　・
.　　 　 .　　　・
.　　 　 .　　　・
2014年　３月　　りんご(文字赤）
【75980】Re:A列B列シートの文字をみて別シートの...
発言  kanabun  - 14/8/15(金) 0:08 -
引用なし
パスワード
   ▼daisuke さん：

Dictionaryを使ってみてはいかが？
まだ、色付けは考えてません。

Sub Try1()
　　Dim dic As Object
　　Dim v
　　Dim i&
　　Dim r As Range
　　
　　'----シート１ Ａ列をきーとして対応するB列を辞書に記憶
　　Set dic = CreateObject("Scripting.Dictionary")
　　v = Worksheets(1).Range("A1").CurrentRegion.Resize(, 2).Value
　　For i = 1 To UBound(v)
　　　　dic(v(i, 1)) = v(i, 2)
　　Next
　　
　　'---- シート２
　　With Worksheets(2)
　　　　Set r = .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
　　End With
　　v = r.Value　'C列の値
　　For i = 1 To UBound(v)
　　　　If dic.Exists(v(i, 1)) Then '辞書にあったら値に置換
　　　　　　v(i, 1) = dic(v(i, 1))
　　　　End If
　　Next
　　r.Value = v '書き戻す
End Sub

文字色を変えるなら、
Sub Try2()
　　Dim dic As Object
　　Dim v
　　Dim i&
　　Dim r As Range, c As Range
　　
　　'----シート１ Ａ列をきーとして対応するB列を辞書に記憶
　　Set dic = CreateObject("Scripting.Dictionary")
　　v = Worksheets(1).Range("A1").CurrentRegion.Resize(, 2).Value
　　For i = 1 To UBound(v)
　　　　dic(v(i, 1)) = v(i, 2)
　　Next
　　
　　'---- シート２
　　With Worksheets(2)
　　　　Set r = .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
　　End With
　　For Each c In r
　　　　If dic.Exists(c.Value) Then '辞書にあったら値に置換
　　　　　　c.Value = dic(c.Value)
　　　　　　c.Font.Color = vbRed
　　　　End If
　　Next
End Sub
といった感じですかね
【75981】Re:A列B列シートの文字をみて別シートの...
発言  γ  - 14/8/15(金) 8:31 -
引用なし
パスワード
   横から失礼します。

C列に限定した、書式を指定した置換の動作をマクロ記録するとこうなります。
Sub Macro1()
　　Columns("C:C").Select
　　With Application.ReplaceFormat.Font
　　　　.Subscript = False
　　　　.Color = 255
　　　　.TintAndShade = 0
　　End With
　　Selection.Replace What:="R", Replacement:="りんご", LookAt:=xlWhole, _
　　　　SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
　　　　ReplaceFormat:=True
End Sub

あとは、Sheet1の置換組み合わせについて、繰り返しをすればよい、
ことになります。
例えば、こんな風です。
Sub test()
　　Dim ws1 As Worksheet
　　Dim ws2 As Worksheet
　　Dim r　 As Range

　　Set ws1 = Worksheets("Sheet1")
　　Set ws2 = Worksheets("Sheet2")

　　Application.ReplaceFormat.Font.Color = 255　'置換後のフォント色を赤に設定

　　For Each r In ws1.Range("A1", ws1.Range("A1").End(xlDown))
　　　　ws2.Columns("C").Replace What:=r.Value, Replacement:=r.Offset(0, 1).Value, _
　　　　　　 LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
　　　　　　 SearchFormat:=False, ReplaceFormat:=True
　　Next
End Sub
# 少し前から書式指定の置換はあったと思いますが、
# Versionの関係でうまくいかなければ失礼します。
# Versionを書いたほうがいいですよ。
【75982】Re:A列B列シートの文字をみて別シートの...
お礼  daisuke  - 14/8/15(金) 13:03 -
引用なし
パスワード
   お答えありがとうございます。
うまくいきましたが完全一致のみなのでしょうか
シート２のセル内には M 予定　など文字が入っています。
M ××　→　みかん　××　部分一致で置換したいのです。
ちなみにセルの書式は文字列です。
何度もすいません。
よろしくお願いすいます。
【75983】Re:A列B列シートの文字をみて別シートの...
お礼  daisuke  - 14/8/15(金) 13:10 -
引用なし
パスワード
   ▼γ さん
回答ありがとうございます。

記憶では項目を全て書かなくてはいけないく、

考えてくださり本当にすいません。
【75984】Re:A列B列シートの文字をみて別シートの...
発言  kanabun  - 14/8/15(金) 14:52 -
引用なし
パスワード
   ▼daisuke さん：
>お答えありがとうございます。
>うまくいきましたが完全一致のみなのでしょうか
>シート２のセル内には M 予定　など文字が入っています。
>M ××　→　みかん　××　部分一致で置換したいのです。
>ちなみにセルの書式は文字列です。
>何度もすいません。
>よろしくお願いすいます。

じゃ、セルの「最初の一文字が」Mとかだったら、
と考えればいいのでは？

Sub Try2b()
　　Dim dic As Object
　　Dim v
　　Dim i&
　　Dim r As Range, c As Range
　　Dim s As String '◆追加
　　
　　'----シート１ Ａ列をきーとして対応するB列を辞書に記憶
　　Set dic = CreateObject("Scripting.Dictionary")
　　v = Worksheets(1).Range("A1").CurrentRegion.Resize(, 2).Value
　　For i = 1 To UBound(v)
　　　　dic(v(i, 1)) = v(i, 2)
　　Next
　　
　　'---- シート２
　　With Worksheets(2)
　　　　Set r = .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
　　End With
　　For Each c In r
　　　　s = Left$(c.Value, 1)　 '先頭一文字が
　　　　If dic.Exists(s) Then　 '辞書にあったら値に置換
　　　　　　c.Value = dic(s)
　　　　　　c.Font.Color = vbRed
　　　　End If
　　Next
End Sub
【75985】Re:A列B列シートの文字をみて別シートの...
質問  daisuke  - 14/8/15(金) 15:37 -
引用なし
パスワード
   ▼kanabun さん：
ありがとうございます。
先頭とは限らないのです。
せっかく考えてくださったのに私の説明が悪く申し訳ありません。
現状こんな感じです。
セル内（書式文字列）の文字がバラバラに入力されています。
◎◎から出荷　M 予定
◎◎待ち　M
M
M取り扱い中止
などなど

品目だけ記号（記号はA〜GZですがもっと増えていきそうです）でその部分だけ
を変換し変換した文字のみを色を付けたいのです。
お盆の時に申し訳ありません。急ぎませんがなにとぞよろしくお願いします。
【75986】Re:A列B列シートの文字をみて別シートの...
発言  γ  - 14/8/15(金) 17:00 -
引用なし
パスワード
   こんにちは。　　#　外出から戻りました。

>いままで手作業で置換していましたがマクロで効率化したいです。
とのこと。

>M ××　→　みかん　××　部分一致で置換したいのです。
そのケースに関して、どのような手作業をやっていたのか、
回答願います。

日本語で説明したうえで、
マクロ記録のコードをアップしてください。
【75987】Re:A列B列シートの文字をみて別シートの...
発言  kanabun  - 14/8/15(金) 17:39 -
引用なし
パスワード
   ▼daisuke さん：

>先頭とは限らないのです。

>◎◎から出荷　M 予定
>◎◎待ち　M
>M
>M取り扱い中止
>などなど
>
>品目だけ記号（記号はA〜GZですがもっと増えていきそうです）でその部分だけ
>を変換し変換した文字のみを色を付けたいのです。

疑似コードで書くと

>　　'---- シート２
>　　With Worksheets(2)
>　　　　Set r = .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
>　　End With
>　　For Each c In r
　　あるセルの文字列について
　　　　Loopで 記号 A〜GZがあるか？ InStr関数で調べる
　　　　　もしInStr関数が >0 を返したら、
　　　　　　 その位置から 置換文字列で置換する。
　　　　　　 さらに 置換文字列の長さだけFont色を変える
　　　　　End If
　　　　Loopおわり
　　Next c

こうすればよいのでは？
【75988】Re:A列B列シートの文字をみて別シートの...
質問  daisuke  - 14/8/15(金) 17:39 -
引用なし
パスワード
   ▼γ さん：
返信ありがとうございます。

先頭とは限らないのです。
私の説明が悪く申し訳ありません。
現状こんな感じです。
セル内（書式文字列）の文字数がバラバラで記号がどの文字位置に入っているか不明です。

シート２のＣ列
◎◎から出荷M予定
◎◎待ちS
R
M取り扱い中止
など

シート１の品目
記号Ａ列（記号はA〜GZですがもっと増えていきそうです）Ｂ列に置換したい品目があり目で確認。
シート２のＣ列を手動で検索して置換し、かわった所だけ色を付けてます。

◎◎から出荷M予定
◎◎待ちS
R
M取り扱い中止
など

↓

◎◎から出荷ミカン予定
◎◎待ちスイカ
りんご
ミカン取り扱い中止
など

すべて手作業しています。

お手数をお掛けし申し訳ありません。
【75989】Re:A列B列シートの文字をみて別シートの...
発言  γ  - 14/8/15(金) 17:48 -
引用なし
パスワード
   実行したいことは理解しているつもりです。

特に色をつけるところを、どうやっているのか、
具体的に手順を説明してください。
そして、そのマクロ記録を示してください。
サンプル的に一例で構いません。
【75990】Re:A列B列シートの文字をみて別シートの...
質問  daisuke  - 14/8/15(金) 18:01 -
引用なし
パスワード
   ▼γ さん：
度々すいません。

シート２のＣ列を選択
↓
ツールバーの検索で記号（例M)を検索
↓
Mを手入力でミカンに置き換え
↓
ミカンの文字をドラッグして赤色つけ
を繰り返しています。

Mが終わったらつぎはR、S・・・・・・。

すごい手間をかけて作業しています。

よろしくお願いします。
【75991】Re:A列B列シートの文字をみて別シートの...
質問  daisuke  - 14/8/15(金) 18:04 -
引用なし
パスワード
   ▼kanabun さん：

考えてくださってありがとうございます。
疑似をどうコードにするか全くわからず
申し訳ありません。
【75992】Re:A列B列シートの文字をみて別シートの...
発言  γ  - 14/8/15(金) 18:13 -
引用なし
パスワード
   マクロ記録はご存じないのですか？
作業内容がわかっているなら、そのマクロ記録を活かすことができますよ。
下記のコードもそうしたことを元にしています。

すでにkanabunさんから擬似コードの提示がありました。
ですので、蛇足になりますが、
一部にReplaceメソッドにこだわったものを示しておきます。

Sub test2()
　　Dim ws1　　 As Worksheet
　　Dim ws2　　 As Worksheet
　　Dim myRange As Range
　　Dim r　　　 As Range
　　Dim rr　　　As Range
　　Dim repStr　As String
　　Dim p　　　 As Long

　　Set ws1 = Worksheets("Sheet1")
　　Set ws2 = Worksheets("Sheet2")
　　Set myRange = ws2.Range("C1", ws2.Range("C1").End(xlDown))

　　For Each r In ws1.Range("A1", ws1.Range("A1").End(xlDown))
　　　　repStr = r.Offset(0, 1).Value
　　　　myRange.Replace What:=r.Value, Replacement:=repStr, _
　　　　　　 LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
　　　　　　 SearchFormat:=False, ReplaceFormat:=False
　　Next

　　' 色をつけます。
　　For Each r In ws1.Range("A1", ws1.Range("A1").End(xlDown))
　　　　repStr = r.Offset(0, 1).Value
　　　　For Each rr In myRange
　　　　　　p = InStr(rr.Value, repStr)
　　　　　　If p > 0 Then
　　　　　　　　rr.Characters(Start:=p, Length:=Len(repStr)).Font.Color = -16776961
　　　　　　End If
　　　　Next
　　Next
End Sub
【75993】Re:A列B列シートの文字をみて別シートの...
お礼  daisuke  - 14/8/15(金) 18:23 -
引用なし
パスワード
   ▼γ さん：
ありがとうございます。
何時間もかけていた作業が１秒でおわりました。
本当に助かりました。
【75994】Re:A列B列シートの文字をみて別シートの...
お礼  daisuke  - 14/8/15(金) 18:25 -
引用なし
パスワード
   ▼kanabun さん：
γ さんから回答をいただきました。
本当にありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1156 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free