[[20150301100633]] 『検索と上書き用書き込み欄をつくって一致した場所』（ガチ初心者） ページの最後に飛ぶ
[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『検索と上書き用書き込み欄をつくって一致した場所の書き込み内容を上書きできる表を作りたい』（ガチ初心者）
表１を検索欄とFGH上書き欄を作って、
表１のBCDEを検索し２列条件に一致した横列FGHを上書きできる表を作りたいのですが、
いまいちどうやっていいのか、検討がつかないので書き込んでみることにしました。
イメージ画像を作ってみたので参照してみてください。
http://fast-uploader.com/file/6980728976564/
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
私には、無理そうですが、他の方が考える際の参考に質問だけ。
２列条件を満たすものが複数ある場合はどうなるのでしょうか。
優先順位があるのでしょうか。それとも全部表示？
（マナ） 2015/03/01(日) 12:07
どうも、事前準備が長すぎて、コード的には、忸怩たるものがあるんですが。 事前準備(1)を操作でやってもらえれば、コード（処理時間も）はその分、もう少し短くなります。 (R列から右に３列、作業域につかいます）
Sub Test()
Dim r As Range
Dim c As Range
Dim dic As Object
Dim k As String
Dim w As Variant
Application.ScreenUpdating = False
'事前準備(1)
With Range("B4").CurrentRegion
Set r = .Offset(1).Resize(.Rows.Count - 1, 3)
End With
With Range("R5").Resize(r.Rows.Count, r.Columns.Count)
.Formula = "=IF(B5="""",R4,B5)"
.Value = .Value
.Copy
r.PasteSpecial Paste:=xlPasteFormulas
.ClearContents
End With
Application.CutCopyMode = False
'事前準備(2)
Set dic = CreateObject("Scripting.Dictionary")
For Each c In r.Columns(1).Cells
k = c.Value & vbTab & c.Offset(, 1).Value & vbTab & c.Offset(, 2).Value & vbTab & c.Offset(, 3).Value
dic(k) = c.Row
Next
'事前準備終了
'ここからが本当の処理
k = Range("J5").Value & vbTab & Range("K5").Value & vbTab & Range("L5").Value & vbTab & Range("M5").Value
If dic.exists(k) Then
Cells(dic(k), "F").Resize(, 3).Value = Range("N5:P5").Value
Else
MsgBox "マッチしません"
End If
End Sub
（β） 2015/03/01(日) 18:01
βさんの回答見て、自分の思い込みというか根本的な勘違いに気付きました。
リンク先をよく見ていませんでした。
ただ、いまだに ＞２列条件に一致した の部分がよくわかっていません。
（マナ） 2015/03/01(日) 19:16
βさん、マナさんコメントありがとうございます。
疑問にあった「２列条件に一致した」の補足ですが、
優先順位はE列目、C列目、B列目、D列目の順ですが、２列どこでもいいので検索で打ち込んだ種類が完全一致していれば条件にあってるといった感じです。
例えば「A・ ・ ・液晶」と順番に打ち込んだ場合１列目と４列目の条件を満たす横列１３列目を一致のものとして、上書きを実行するという感じです。
ですが、「B・ ・ ・地面」と打ち込んだ場合、横列１７列目と横列２２列目が一致します。
その場合は両方とも書き込み出来ない状態と自分は考えてます。
なので補足としては「２列以上条件に一致した（横列１つの場合に限り）」ということになります
分かりづらい説明でもうしわけないです。。
（ガチ初心者） 2015/03/01(日) 20:35
「A・ ・ ・液晶」、「B・ ・ ・地面」 ??? 液晶？地面？？
いずれにしても、アップしたコードを実行して、こちらに勘違いがあるのかどうか、試してみてください。 なお、マナさんがいわれる、同じもの（４条件がおなじもの）が複数あった場合（実際にはないのでしょうが） 私のコードではあと勝ち（下の行）になります。
あと、私のコードは【４条件がマッチしているかどうか】というロジックになっています。 ４条件のうち、２条件、３条件のみのマッチングは想定していません。
（β） 2015/03/01(日) 20:51
よくよくリンク先を見たら、私も誤解していたようです。 ただ、「２列以上」というコメント、私も理解できないなぁ。
でも、とにかく、４条件がすべて入力されるわけではなさそうですね。 であれば、私のコードの 準備(1) の後、このリストにオートフィルターを設定して 指定された、Ｊ５〜Ｍ５の語句で、それぞれフィルタリング。 抽出された行に、Ｎ５〜Ｐ５を転記するのかな？
（β） 2015/03/01(日) 20:58
考え方だけで失礼します。
まずは、検索に都合の良いリスト形式に変換しておきます。
（ここはβさんが既に指摘されています。）
フィルタオプションを利用した検索を、
シートのChangeイベントプロシージャに書いておけば、
条件入力と同時にインタラクティブに検索がされるんじゃないでしょうか。
二つ以上といわず、一つの条件でも一つの結果に絞れる場合もあるはずです。
（γ） 2015/03/01(日) 21:34
条件が１つでも入力されていれば実行するタイプです。 オートフィルターを使いました。
Sub Test2()
Dim r As Range
Dim c As Range
Dim ok As Boolean
If WorksheetFunction.CountBlank(Range("J5:M5")) = 4 Then
MsgBox "条件が入力されていません"
Exit Sub
End If
Application.ScreenUpdating = False
ActiveSheet.AutoFilterMode = False 'Just In Case
With Range("B4").CurrentRegion
Set r = .Offset(1).Resize(.Rows.Count - 1, 3)
End With
'事前準備
With Range("R5").Resize(r.Rows.Count, r.Columns.Count)
.Formula = "=IF(B5="""",R4,B5)"
.Value = .Value
.Copy
r.PasteSpecial Paste:=xlPasteFormulas
.ClearContents
End With
Application.CutCopyMode = False
'事前準備終了
Range("B4").AutoFilter
With ActiveSheet.AutoFilter.Range
If Len(Range("J5").Value) > 0 Then .AutoFilter Field:=1, Criteria1:=Range("J5").Value
If Len(Range("K5").Value) > 0 Then .AutoFilter Field:=2, Criteria1:=Range("K5").Value
If Len(Range("L5").Value) > 0 Then .AutoFilter Field:=3, Criteria1:=Range("L5").Value
If Len(Range("M5").Value) > 0 Then .AutoFilter Field:=4, Criteria1:=Range("M5").Value
If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
ok = True
For Each c In r.Rows
If Not c.Hidden Then c.EntireRow.Range("F1:H1").Value = Range("N5:P5").Value
Next
End If
End With
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
If Not ok Then MsgBox "マッチしません"
End Sub
（β） 2015/03/01(日) 21:41
γさん、βさんコメントありがとうございます
自分の説明でやたら誤解を生んでしまっているようなので、少し考え方を変えてみました・・・。
検索条件の見直しをして、
B・C・D・EからB・Eだけにまず減らします。（名称の候補が２つ以上でも種類が絶対に違うので、１つに絞られると思います。）
上書き数は変わらないです。
相変わらず分かりづらい説明なのでイメージ画像作りました。
（ガチ初心者） 2015/03/01(日) 22:54
まだよく理解できていませんが、
>「２列以上条件に一致した（横列１つの場合に限り）」 >名称の候補が２つ以上でも種類が絶対に違うので、１つに絞られると思います。
最終的に１つに絞り込んだ上での上書きであれば 元の表をオートフィルタで絞り込んで、直接上書きすればマクロ不要ではありませんか？
勿論、表は結合セルにせず、作り直しが必要ですが。
（マナ） 2015/03/01(日) 23:54
ところで、βさんのマクロは試されているのでしょうか?
（マナ） 2015/03/01(日) 23:58
マナさんコメントありがとうございます。
ほんとに初心者なのでオートフィルタやマクロなどほぼ手探り状態でやっているので、
聞いておいて大変失礼なのですが自分自身理解できてないところが多々あります。。
βさんのマクロも試しているのですが、どうにもうまくいってない感じです。
ボタンを作成→マクロソースを貼り付け→M5「液晶」R5「1」S5「0」T5「6」をそれぞれ書き込み→実行
→FGH列の5〜14列が真っ白になる
といった感じになってます・・・
（ガチ初心者） 2015/03/02(月) 00:35
どうも・・・わからないことだらけです。
まず、アップした Test、Test2 ともに（Testのほうは、要件の勘違いだと思いますが）、条件がマッチすれば当該行のＦ，Ｇ，Ｈ列に値をセット。 マッチしなければ、マッチしないというメッセージを出しています。メッセージも出ず、かつ、全行が空白になるということは考えられません。
最初にリンク先でサンプルを見たときも、今回の、↑で直接掲載されたサンプルも、Ｂ〜Ｈ列は、全く同じもので、Ｂ列は Ａ、Ｂ、Ｃ、・・・ ところが、2015/03/01(日) 20:35 のコメントも、2015/03/02(月) 00:35 のコメントも 「液晶」が登場。液晶って？
いずれにしても、アップしたコードは、当初のレイアウト、つまり、Ｊ５〜Ｍ５ が検索語句、Ｎ５〜Ｐ５が転記語句。 たとえ、そちらでレイアウトを変更されても、コードは、もとのままですから、そのまま実行しても具合悪いですね。
そもそも、（β） 2015/03/01(日) 18:01 でコメントした通り、「 (R列から右に３列、作業域につかいます）」 これは、どこでもよかったんですが、最初のリンク先のイメージで、このあたりがあいていたので。 そこは、結合されていない普通の領域だと理解しています。 だけど・・・・
【M5「液晶」R5「1」S5「0」T5「6」をそれぞれ書き込み】？？？？？
R5 ? S5? T5 ?
実際には、そういうレイアウトなんですか？
ただ、アップしたコードの事前準備に不足がありました。ここでは、結合セルの裏に隠れているセルに値を埋め込んでいるんですが 一度埋め込んだ値は、仮に、そのあと、Ｂ〜Ｄ列の値を変更しても、裏の値は変わらないので、正しい処理がされなくなります。 レイアウトが明確になれば、そこを改訂したものをアップしますが、まず、その前に以下の手順で、オートフィルター操作を してもらえませんか。
まず、以下のマクロを実行してください。（裏に隠れた値をクリアします）
Sub Try1()
Dim r As Range
Dim c As Range
With Range("B4").CurrentRegion
Set r = .Offset(1).Resize(.Rows.Count - 1, 3)
End With
For Each c In r.Cells
If c.Address <> c.MergeArea(1).Address Then
c.Value = Empty
End If
Next
End Sub
次に、このシートの、ずっと右のほう、マクロではＲ列にしましたが、たとえば Ｚ列のＺ５に =IF(B5="",Z4,B5) といれてください。 で、この Z5を右にAB5までフィルコピー。さらに、Z5〜AB5 を下に表の最後の行（サンプルでは２７行目）までフィルコピー。 この、Z5:AB27 を選択した状態で Ctrl/c。そのまま、形式を選択して【値】で貼り付け。 もう一度、Ctrl/c。で、B5を選んで、形式を選択して【数式】で貼り付け。
こうした上で、Ｂ４を選んで、オートフィルターを設定し、Ｂ列〜Ｅ列の任意の列に対して絞り込みを行ってみてください。
↑で聞いている質問の回答と、オートフィルター試行の結果の報告をお待ちします。
（β） 2015/03/02(月) 04:36
大変へんな誤解をしていました・・・。
「R列から右に３列、作業域につかいます」を自分はR列S列T列に上書きデータを入れるものと勘違いしていました。
本来のレイアウト（一番最初の画像のレイアウト）でやったところ、普通に書き換えに成功しました・・・お騒がせして申し訳ないです・・・。
次にあるマクロの実行は学校から帰ってから行いますので先に、致命的なミスをしていたとだけ報告を・・・。
（ガチ初心者） 2015/03/02(月) 07:02
ぜひ、コメントした操作を試してみてください。 結合セルを含むリストにオートフィルターを掛ける定番の操作です。 （裏に隠れているセルの値をセットしたのちに、リストの内容を変更すると具合が悪くなりますが）
それとは別に、アップ済みのコードに、セットされた裏のセルの値のクリアを追加したコードもアップしておきます。 （事前準備に１行追加）
Sub Test3()
Dim r As Range
Dim c As Range
Dim ok As Boolean
If WorksheetFunction.CountBlank(Range("J5:M5")) = 4 Then
MsgBox "条件が入力されていません"
Exit Sub
End If
Application.ScreenUpdating = False
ActiveSheet.AutoFilterMode = False 'Just In Case
With Range("B4").CurrentRegion
Set r = .Offset(1).Resize(.Rows.Count - 1, 3)
End With
'事前準備
r.Value = r.Value
With Range("R5").Resize(r.Rows.Count, r.Columns.Count)
.Formula = "=IF(B5="""",R4,B5)"
.Value = .Value
.Copy
r.PasteSpecial Paste:=xlPasteFormulas
.ClearContents
End With
Application.CutCopyMode = False
'事前準備終了
Range("B4").AutoFilter
With ActiveSheet.AutoFilter.Range
If Len(Range("J5").Value) > 0 Then .AutoFilter Field:=1, Criteria1:=Range("J5").Value
If Len(Range("K5").Value) > 0 Then .AutoFilter Field:=2, Criteria1:=Range("K5").Value
If Len(Range("L5").Value) > 0 Then .AutoFilter Field:=3, Criteria1:=Range("L5").Value
If Len(Range("M5").Value) > 0 Then .AutoFilter Field:=4, Criteria1:=Range("M5").Value
If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
ok = True
For Each c In r.Rows
If Not c.Hidden Then c.EntireRow.Range("F1:H1").Value = Range("N5:P5").Value
Next
End If
End With
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
If Not ok Then MsgBox "マッチしません"
End Sub
（β） 2015/03/02(月) 20:57
βさん長々とつきあっていただいてありがとうございました。
問題なく上書き実行できています！
語彙力の乏しい発言が多々有り混乱を生んでしまいすみませんでした。。
エクセルの勉強もいいですが、日本語の勉強もしっかりしたいと思います。
コードを書いていただいた方ならびにコメントくれた方々ほんとうにありがとうございました！
（ガチ初心者） 2015/03/02(月) 22:48
コメント返信：
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.