[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『条件検索して当てはまるセルに対応するセルの値を別のシートに転記』(もかもか)
[シート1]
日付 4/1 4/2 4/3 4/4 4/5 4/6 4/7 4/8 4/9 4/10
品種 A B C D E F G H I J
添加物 a b c d e f g h i j
添加物の 3/30 4/1 4/1 4/2 4/1 4/2 4/2 4/6 4/5 4/8
入庫日
↓
[シート2]
日付 3/30 3/31 4/1 4/2 4/3 4/4 4/5 4/6 4/7 4/8
添加物 a b d i h j
c f
e
シート1を入力すると、シート2のように日付別にいつ添加物を入荷するべきかすぐに分かるようなプログラムを作成したいです。
途中まで作ったのですが、うまく動きません。
上記の表と少し異なりますが、作ったプログラムを見ていただけないでしょうか?
sub
Dim target As Range '検索値(文字列型)
Dim day As String '検索する日付 Dim searchrng As Range '検索範囲 Dim firsttarget As Range '最初に検索したセル(文字列型) Dim i As Integer Dim j As Integer
Set searchrng = Worksheets("転記用").Range("K39:AF44") '検索するセルの範囲を指定(日付検索)
For i = 5 To 32
day = Worksheets("転記用").Cells(4, i).Value Set target = searchrng.find(day, LookIn:=xlValues, Lookat:=xlWhole) 'Findで検索 Set firsttarget = target
j = 15 '値を転記したい最初の行が15行目
Do While Not target Is Nothing '条件に合ったセルが見つからなければNothingが返り、何も処理しない Worksheets("準備表").Cells(j, i).Value = Cells(j, i).Offset(-24, 0).Value '見つけたセルの24行上の値をj行目のi列に転記する Set target = searchrng.FindNext(target) '検索を継続
If target.address = firsttarget.address Then '最初に見つけたセルと一致したらDoを抜ける Exit Do End If
j = j + 1 Loop Next i
end sub
< 使用 Excel:unknown、使用 OS:unknown >
(1) Dim day As String を Dim day As Date に変更。 (2) Set target = searchrng.find(day, LookIn:=xlValues, Lookat:=xlWhole) ↓ Set target = searchrng.find(day, LookIn:=xlFormulas, Lookat:=xlWhole) に変更して実行してみてください。
Findを使った 日付検索には結構トリッキーなところがあるらしい。 下記を参照してください。 http://officetanaka.net/excel/vba/tips/tips131b.htm http://officetanaka.net/excel/vba/tips/tips131c.htm http://officetanaka.net/excel/vba/tips/tips131d.htm
なお、検索のところしか見ていない。 転記部分は、説明とコードが違っていて余り意味がない。 そこはご自分で確認して下さい。
(γ) 2020/05/25(月) 05:41
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.