Excel VBA質問箱 IV

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

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


7861 / 13644 ツリー ←次へ | 前へ→

【36408】マッチングの後、別シートに日付を・・・ 年寄 06/3/30(木) 16:46 質問[未読]
【36410】Re:マッチングの後、別シートに日付を・・・ Blue 06/3/30(木) 16:51 発言[未読]
【36411】Re:マッチングの後、別シートに日付を・・・ Kein 06/3/30(木) 16:59 回答[未読]
【36412】Re:マッチングの後、別シートに日付を・・・ 年寄 06/3/30(木) 17:05 お礼[未読]

【36408】マッチングの後、別シートに日付を・・・
質問  年寄  - 06/3/30(木) 16:46 -

引用なし
パスワード
   初めまして。本やサイトを参考にしましたが一向に進まず、質問させていただきます。

まず、sheet1に
      A列       B列        
1行    A123456789    OK   ★コマンドボタン★
2行    B123456789    OK
3行    C123456789    
4行    D123456789    OK

というデータとコマンドボタンがあります。そのコマンドボタンを押して
B列に 『 "OK"  』と出た隣にある、『 A列のデータ "A123456789" 』と

sheet2
       B列     C列               K列
1行      11    A123456789           2006/03/15 完了
2行      11    B123456789           2006/03/15 完了
3行      11    C123456789    
4行      12    D123456789           2006/03/15 完了

の『 C列のデータ 』とマッチングさせて合致した時、K列に「その時の日付と文字」 " 2006/03/15 完了"
を入力させたい場合、sheet1のコマンドボタンのプロシージャはどうすればいいか分かりますでしょうか?
『 "OK"  』が無いデータの場合、日付は空欄にしたいと思います。
イメージ的には、sheet1のB列をDo〜LoopもしくはFor〜Nextして、『 "OK"  』かどうかをIf〜thenで判定して
OKならsheet2のC列をFindしてOffsetでセルに日付を入れる方法が思い浮かぶのですが、全然繋がりません・・・

ベテランの皆様よろしくお願いします。

【36410】Re:マッチングの後、別シートに日付を・...
発言  Blue  - 06/3/30(木) 16:51 -

引用なし
パスワード
   ほとんど同じような質問を別の掲示板でしている方がいましたので参考にしてください。
http://hpcgi1.nifty.com/kenzo30/b_cbbs/cbbs.cgi?mode=al2&namber=31094&rev=&no=0

【36411】Re:マッチングの後、別シートに日付を・...
回答  Kein  - 06/3/30(木) 16:59 -

引用なし
パスワード
   てゆーか、同一人物でしょうね。あちらはマルチポストは禁止されてますが、
こちらはOKで「後から書き込むのだから大丈夫」とみなしたわけですね。
ま、殆ど変更するところもないので、あちらのコードをコピぺ&一部書き直し、
ということで・・

Sub Data_Check()
  Dim MyR As Range, C As Range
  Dim St As String
  Dim Ck As Variant

  On Error GoTo ELine
  With Sheets("Sheet1")
    With .Range("A1", .Range("A65536").End(xlUp)).Offset(, 26)
      .Formula = "=IF($B1=""OK"",$A1,1)"
      Set MyR = .SpecialCells(3, 2)
    End With
  End With
  St = Format(Date, "yyyy/mm/dd") & " 完了"
  With Sheets("Sheet2")
    For Each C In MyR
     Ck = Application.Match(C.Value, .Range("B:B"), 0)
     If IsError(Ck) Then
       C.Offset(, -26).Resize(, 2).Font.ColorIndex = 3
     Else
       .Cells(Ck, 11).Value = St
             '↑ここを3から11にするだけ
     End If
    Next
    .Columns(3).AutoFit
  End With
  Sheets("Sheet1").Range("AA:AA").ClearContents
  Set MyR = Nothing: Exit Sub
ELine:
  MsgBox "「OK」のチェックがついたデータがありません", 48
End Sub

*あちらは解決マーク付けておいて下さい。

【36412】Re:マッチングの後、別シートに日付を・...
お礼  年寄  - 06/3/30(木) 17:05 -

引用なし
パスワード
   あちこちで聞くのをマルチポストと言うんですか?
あまりインターネットはしないのでマナー違反だったら申し訳ありませんでした。
とにかくありがとうございました。

7861 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free