『日付で転記』（みか） 入力用シート1　Ａ1に日付2013/10/3　Ｂ1にリンゴ　Ｃ1にみかん　Ｄ1にぶどう 転記したいシート2　Ａ1〜Ａ31まで10/1〜10〜30の日付31日は今月はありませんので空白 このシート2の日付を認識をしてＣ1にリンゴ　Ｄ1にみかん　Ｅ1にぶどうと転記したいのですがおしえていただきませんか？宜しくお願いします ---- >シート2の日付を認識をしてＣ1にリンゴ　Ｄ1にみかん　Ｅ1にぶどうと転記 シート1のＡ1に日付が2013/10/3なら、シート2の10/3はA3にありますよね？ Ｃ3にリンゴ　Ｄ3にみかん　Ｅ3にぶどうでいいなら。 シート2のC1に =IFERROR(VLOOKUP($A1,Sheet1!$A$1:$D$1,COLUMN(B1),0),"") とし、右及び下に引っ張ってコピー ※IFERROR関数はエクセル2003以前だと使用できません。 （usamiyu） 2013/11/04(月) 00:09 ---- Sheet1に入力するのは1行目だけ。 Sheet1のA1が 2013/10/3 のとき、Sheet2に表示されるのは「3行目」の間違いなら 日付はすべてシリアル値だとして。 C1 =IF(Sheet1!$A$1=$A1,Sheet1!B$1,"") 右・下コピーでいいんでない？ 　 　 >Ａ1〜Ａ31まで10/1〜10〜30の日付31日は今月はありませんので空白 10月と11月を混同してない？ 　 （名無しのおっさん） 2013/11/04(月) 07:00 ---- 質問者が戻ってこないけど、たぶん上の解釈は間違ってるだろうね。 Sheet1に入力するのは「1行目だけ」というのは正しいとして、 A1に 2013/10/3 と入力すれば、Sheet2の3行目にデータを転記し そのあと同じA1に上書きで　2013/10/10 と入力すれば、Sheet2の10行目に転記する ただし 10/3 のデータも消えずに残っている やりたいのはこういうこと？ そうだとしたら、まずは次の質問に答えてちょ。 Sheet1に入力するのは1行目だけでないとダメなの？ つまり1行目に入力したら、次は2行目に入力 2行目に入力したら、次は3行目に入力 というふうにデータを上書きせずに残しておくのではダメなのかってこと。 あとExcelのバージョンも書いてちょ。 きっと優しい誰かが回答してくれるｗ 　　 （名無しのおっさん） 2013/11/04(月) 21:07 ---- Sheet1のＡ1に日付　Ｂ1に100　Ｃ1に200　Ｄ1に300 Sheet2のＡ1〜Ａ31に日付　 Sheet1のＡ1に日付を識別してＢ1　Ｃ1　Ｄ1　と　Ｂ1に100　Ｃ1に200　Ｄ1に300 と Sheet1で入力されたＢ1に100　Ｃ1に200　Ｄ1に300　Sheet2にこの答えを値で貼りつけ 転記したいです。出来たらマクロで実行した時にこの動きをしたいのですが出来ませんか？ 一度転記して貼りつけた値は入力した時以外は消えない このコードは日付で貼りつけはできませんが　 Sub Tenki() 　　Dim i As Long 　　With Sheets("Sheet2") 　　　　i = .Cells(Rows.Count, "A").End(xlUp).Offset(1).Row 　　　　.Range(.Cells(i, "A"), .Cells(i, "C")).Value = Sheets("Sheet1").Range("A2:C2").Value 　　End With End Sub こんな風に日付を検索して転記したいのですが よろしくおねがいします （みか） 2013/11/04(月) 22:34 ---- >シート2の日付を認識をしてＣ1にリンゴ　Ｄ1にみかん　Ｅ1にぶどうと転記 確認ですが、コピー元はB列からD列だけど、貼り付け先はC列からE列でいいんですよね？ 次のではいかがですか。 Sub test() Dim d As Double Dim sh1 As Worksheet Dim sh2 As Worksheet Dim r As Range Dim x As Variant Set sh1 = Sheets("Sheet1") Set sh2 = Sheets("Sheet2") Set r = sh2.Range("A1", sh2.Range("A" & sh2.Rows.Count).End(xlUp)) d = sh1.Range("A1").Value x = Application.Match(d, r, 0) If IsNumeric(x) Then sh2.Range("A" & x).Offset(, 2).Resize(, 3).Value = _ sh1.Range("A1").Offset(, 1).Resize(, 3).Value End If 　End Sub （usamiyu） 2013/11/04(月) 23:48 ---- usamiyuさん回答有難うございます。 マクロの動きは理想の動きになっております。 このコードを離れたセルにも対応したいのですが 難しそうなので実際の配置で質問よろしいでしょうか・・・ Sheet1　転記される列の日付がＦ16　数値が入力されるセルＢ25　Ｃ25　Ｄ25　Ｅ25　Ｆ25　Ｇ25　Ｈ26　Ｈ28　Ｌ25　Ｌ26 Sheet2に日付がＡ列にＡ2〜Ａ３２に入力されています。 転記されるシートSheet2　Ｂ25の値がSheet2Ｄ列　Ｃ25がSheet2Ｅ列　Ｄ25がSheet2Ｆ列　Ｅ25がSheet2Ｇ列　Ｆ25がSheet2Ｈ列　Ｇ25がSheet2Ｉ列　Ｈ26がSheet2Ｏ列　Ｈ28がSheet2Ｍ列　Ｌ25がSheet2Ｋ列　Ｌ26がSheet2Ｌ列 Ａ列の日付を検索して値を入力したいのですが・・・ 二度手間になってしまいすみませんです。 よろしくお願いします。 （みか） 2013/11/05(火) 00:31 ---- Sub test2() Dim d As Double Dim sh1 As Worksheet Dim sh2 As Worksheet Dim r As Range Dim x As Variant Set sh1 = Sheets("Sheet1") Set sh2 = Sheets("Sheet2") Set r = sh2.Range("A1", sh2.Range("A" & sh2.Rows.Count).End(xlUp)) d = sh1.Range("F16").Value x = Application.Match(d, r, 0) If IsNumeric(x) Then With sh2.Range("A" & x) .Offset(, 3).Resize(, 6).Value = _ sh1.Range("A1").Offset(24, 1).Resize(, 6).Value 'sheet1 b25-g25 .Offset(, 10).Value = _ sh1.Range("A1").Offset(24, 11).Value 'sheet1 l25 .Offset(, 11).Value = _ sh1.Range("A1").Offset(25, 11).Value 'sheet1 l26 .Offset(, 14).Value = _ sh1.Range("A1").Offset(25, 7).Value 'sheet1 h26 .Offset(, 12).Value = _ sh1.Range("A1").Offset(27, 7).Value 'sheet1 h28 End With End If End Sub （usamiyu） 2013/11/05(火) 09:54 ---- usamiyuさん教えていただきありがとうございます。 凄いですね・・・わたしにはさっぱり？？？ 今回質問したのは横に入力ですがこれを横以外のセルには入力可能なのでしょうか？ Ｊ25の値がSheet2Ｋ列　Ｊ26がSheet2Ｍ列　Ｊ27がSheet2Ｏ列　 Sheet2のＡ列の日付が無理でしたらSheet2のＪ36：Ｊ66に10/1〜10/31までの日付が入力されています。Ｊ36：Ｊ66でしたら入力せるは横並びになります。 もし同じコード内で可能でしたら今一度教えていただけないでしょうか？ 宜しくお願いします。 （みか） 2013/11/05(火) 21:13 ---- >Ｊ25の値がSheet2Ｋ列　Ｊ26がSheet2Ｍ列　Ｊ27がSheet2Ｏ列 test2のコードではL25がSheet2 K列、L26がSheet2 M列、H26がSheet2 O列になってます。 それぞれのセルは上記コード中にコメントをつけてます（’のついているところ）。 だから、代入先は式の左辺ですから、そのまま同じです。 右辺（代入するセル）をそれぞれ、新しくコメントされたJ25,J26,J27に変更すればいいだけです。 たとえば今のコードだとL25の値は、式の右辺であるsh1.Range("A1").Offset(24, 11).Valueがそれにあたります。 　Offsetはヘルプを調べると、 式.offset(オフセットする範囲の行数,オフセットする範囲の列数)です。 つまり、シート1のA1から24行下、11列右のセルの値がL25ということです。 すると、J25,J26,J27の各セルはどうあらわすのか、わかるのではないでしょうか？ 　 （usamiyu） 2013/11/05(火) 23:31 ---- お世話になります。 .Offset(, 10).Value = _ sh1.Range("A1").Offset(24, 9).Value 'sheet1 j25 でやりましたがシート2の.Offset(, 10).Value =がどうしてもＡ列の日付を検索してしまい Ｊ列Ｊ36：Ｊ66の日付から検索できません？Ｋ列のＫ36：Ｋ66で入力するにはどうしたらいいのでしょうか？ （みか） 2013/11/06(水) 05:32 ---- >sh1.Range("A1").Offset(24, 9).Value でやりました ここはこれで合ってます。 >Sheet2のＡ列の日付が無理でしたらSheet2のＪ36：Ｊ66に 無理じゃないので、A列から検索する方法しか述べていません。 J列？それともK列？から検索するようにコードを変更するなら、今のコードが何をしているか 理解して、まずはご自分で変更してみてください。 その上で、自分ではこう考えて、こうしてみたけれど、うまく行かないということであれば、 変更した部分を載せて質問してください。 理解するにあたって、参考ページを載せてみます。 このコードは下記ページで説明されているのと同じで、ワークシート関数のMatchを使用して 検索しています。Match関数を調べるとどこが検索範囲かわかるのではないでしょうか。 http://www.moug.net/tech/exvba/0100004.html それから、コードを理解するには、F8キーを押してステップ実行するのが有効です。 こうすると1行ずつコードが実行されるので、そのつどワークシートと変数の値を確認 するとその1行のコードが何をしているかがわかります。 　 （usamiyu） 2013/11/06(水) 13:21 ---- 色々考えて試していますが理屈はなんとなくわかりますがどうしても sh1.Range("A1").Offset(24, 9).Valueこの部分の座標はわかりましたが .Offset(, 10).Value = _にするとsh1.Range("A1").Offset(24, 11).Value 'sheet1 l25 とだぶってしまいもす。そもそもこのコードだと違う事はわかっておりますが・・・ 新たにＪ列Ｊ36：Ｊ66の日付を作りＫ列のＫ36：Ｋ66で入力したいので試していますがまったく？？？ コードを提示と言われても沢山ありすぎてどれが一番いいのすらわかりません？ どれをどうにしてもエラーになります。確かに教えていただく身分ですので色々試してもいます。 しかしながら何も努力していない言い方をされてしまいます。 マクロ自動記録位しかやったことないのでいきなりコードみせられても？？？ わかる方には簡単でも素人には？？？すみませんでした。色々さらに試して勉強します。 色々有難うございました。勉強して出直してきます。 （みか） 2013/11/06(水) 17:55 ---- 多少の変更とコメントを追加してみました。 ご自身で理解出来る書き方から始められてはどうですか？ Sub test4() Dim d As Double Dim sh1 As Worksheet Dim sh2 As Worksheet Dim r As Range Dim x As Variant Set sh1 = Sheets("Sheet1") '入力用シートを設定 Set sh2 = Sheets("Sheet2") '転記用シートを設定 Set r = sh2.Range("J36:J66") '検索範囲を設定 d = sh1.Range("F16").Value '検索値を設定(変数に代入) x = Application.Match(d, r, 0) 'MATCH関数で検索 If IsNumeric(x) Then '検索値が日付か調べる '// 転記 //////////////////////////////////////////////////////////////////////////////////// '転記開始位置を 「K36」 とした場合、Offsetプロパティを使うと Range("K36").Offset(0, 0)となりますが '上記で求められる x は 一致した日付が有れば 1以上なので '下記では Range("K35") と 1減らしています。 With sh2.Range("K" & 35 + x) .Offset(, 0).Value = sh1.Range("j25").Value 'sheet2 K列へ転記 .Offset(, 2).Value = sh1.Range("j26").Value 'sheet2 M列へ転記 .Offset(, 4).Value = sh1.Range("j27").Value 'sheet2 O列へ転記 End With '///////////////////////////////////////////////////////////////////////////////////////////// End If End Sub （mitsu） 2013/11/07(木) 00:13 ---- （mitsu）さん　遅い時間にお手数をおかけしてしまって、すみません。 （usamiyu） 2013/11/07(木) 09:27 ---- usamiyuさんusamiyuさん まるうつしをして組み込んだだけですがこの様にしました。 このコードでも転記しています。 ここまでヒントをいただきありがとうございました。 Dim d As Double Dim sh1 As Worksheet Dim sh2 As Worksheet Dim r As Range Dim x As Variant Set sh1 = Sheets("詳細") Set sh2 = Sheets("売上表") Set r = sh2.Range("A1", sh2.Range("A" & sh2.Rows.Count).End(xlUp)) d = sh1.Range("Ｊ10").Value x = Application.Match(d, r, 0) If IsNumeric(x) Then With sh2.Range("A" & x) .Offset(, 3).Resize(, 6).Value = _ sh1.Range("A1").Offset(24, 1).Resize(, 6).Value 'sheet1 b25-g25 .Offset(, 10).Value = _ sh1.Range("A1").Offset(24, 11).Value 'sheet1 l25 .Offset(, 11).Value = _ sh1.Range("A1").Offset(25, 11).Value 'sheet1 l26 .Offset(, 14).Value = _ sh1.Range("A1").Offset(25, 7).Value 'sheet1 h26 .Offset(, 12).Value = _ sh1.Range("A1").Offset(27, 7).Value 'sheet1 h28 End With End If Set sh1 = Sheets("詳細") '入力用シートを設定 Set sh2 = Sheets("売上表") '転記用シートを設定 Set r = sh2.Range("J36:J66") '検索範囲を設定 d = sh1.Range("J10").Value '検索値を設定(変数に代入) x = Application.Match(d, r, 0) 'MATCH関数で検索 If IsNumeric(x) Then '検索値が日付か調べる With sh2.Range("K" & 35 + x) .Offset(, 0).Value = sh1.Range("j25").Value 'sheet2 K列へ転記 .Offset(, 2).Value = sh1.Range("j26").Value 'sheet2 M列へ転記 .Offset(, 4).Value = sh1.Range("j27").Value 'sheet2 O列へ転記 End With End If End Sub （みか） 2013/11/07(木) 21:22 ---- 目的のことを達成できて、なによりでした。 （usamiyu） 2013/11/07(木) 22:04