エクセルVBAの書き方を教えてください 削除
| Message#4 2015年2月5日(木)17時24分 From: takkus |
| 今は、プロトタイプですから、こういうものを使って、細かい調整が必要になるかもしれませんし、また、大幅に変えたほうがよいかもしれません。まずはたたき台として、提示します。 個人的には、他にも方法もあるとは思っていますが、簡単なものを選びました。 ・コードの貼り付け方と、使い方： これは、Sheet2のタブを右クリックして、「コードの表示」をクリツクし、VBEの画面を出し、そこに貼り付けます。 使い方は、Sheet2のセルに一つ入金日を入れたら、Sheet1 側に番号を検索し、転機した入金日と検索された番号のセルに色を付けていくという方法です。入金したものと区別をつけるためで、同じ色がついているとマクロでは、コピー＆ペーストができないようになっています。 実用度を増すために、エラー処理はいくつか施してあります。不要なら、取り去ってもよいです。 このコードは、キーを入力をした時に発生する信号で、マクロが起動するようになっています。 '//Sheet2 に貼り付ける Private Sub Worksheet_Change(ByVal Target As Range) Dim ws1 As Worksheet Dim ws2 As Worksheet Dim SrchTxt As Variant Dim c As Range Dim i As Long Const FCOLOR As Integer = 14 '濃い緑 フォントに色付け Set ws2 = Me Set ws1 = Worksheets("Sheet1") If Target.Column <> 4 Then Exit Sub If Not IsDate(Target.Value) Then Exit Sub If Target.Offset(, -1).Value = "" Then MsgBox "番号が見当たりません。", vbExclamation: Exit Sub SrchTxt = Target.Offset(, -1).Value ws1.Activate 'シートの切り替わり Set c = ws1.Columns(1).Find(SrchTxt, , xlValues, xlWhole) If Not c Is Nothing Then c.Select 'セルに飛ぶ If c.Font.ColorIndex <> FCOLOR Then c.Offset(, 1).Value = Target.Text c.Resize(, 2).Font.ColorIndex = FCOLOR i = Application.CountIf(ws1.Columns(1), SrchTxt) If i > 1 Then MsgBox SrchTxt & "は" & i & "個あるようです。", vbExclamation Else MsgBox SrchTxt & "は、既に入金済になっています。", vbExclamation End If Else MsgBox SrchTxt & "が見つかりません。", vbExclamation End If Set c = Nothing Set ws1 = Nothing Set ws2 = Nothing End Sub '// なお、まとめて一気にやる方法は、コードが違いますから、その時は、その旨をおっしゃってください |
上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。
