エクセルVBAでデータの蓄積方法？

質問

いつも参考にさせてもらっています。
エクセルの２０１３で下記のようなテレフォンアポイント用のデータがあります。
(1)(2)のようなマクロボタンを作成するにはどのようにしたらよろしいでしょうか？ご教授の程よろしくお願いいたします。

A　　　　B　　　　　C　　　　　D　　　
顧客名 電話番号　架電日　　架電履歴　

DA　　　　　DB　　　　　　DC　　　　　　DD
一回目の日　一回目の履歴　二回目の日　二回目の履歴・・・・・

★マクロボタンを押すと下記(1)(2)が実行されるマクロ
(1)CとDの架電日と架電履歴をDA以降の列に反映れる
例）CのデータがDA　DのデータがDB
DA　 DB　 DC　 DD　 DE　 DF　
1/10 留守　1/11 留守　1/14 提案中・・・・・

顧客によって架電回数に違いがでるため、イメージ的にはDAにデータが入っていたらDC、DCにデータが入っていたらDEのようにどんどん蓄積されていくイメージです。

(2)CとDのセルのデータはクリアされる

よろしくお願いします。

回答No.2

keithin · ベストアンサー

んじゃ折角なので
＞イメージ的にはDAにデータが入っていたらDC、DCにデータが入っていたらDEのようにどんどん蓄積

という通りに作成してみます。

private sub CommandButton1_Click()
　dim h as range
　dim c as long
　on error goto errhandle

　for each h in range("C:C").specialcells(xlcelltypeconstants, xlnumbers)
　’次のヒトカタマリはオマケ機能。不要なら削除。
　　if h.offset(0, 1) = "" then
　　　h.offset(0, 1).select
　　　msgbox "履歴が記入されていない"
　　　exit sub
　　end if

　’入ってないとこをどんどん探す
　　c = 105
　　do until cells(h.row, c) = ""
　　　c = c + 2
　　loop

　　h.resize(1, 2).copy cells(h.row, c)
　　h.resize(1, 2).clearcontents
　next
errhandle:
end sub

＃Ｄ列に記入したら自動転記しちゃう案も考えましたが，まぁ何件か記入した後にボタンをポチるとまとめて待避する今のアイデアの方が，使い良いカモですね。

お礼

ありがとうございました。
助かりました！！

回答No.1

tom04

こんにちは！

↓の画像のように顧客一人につき1行使用するとします。
Sheet上にコマンドボタンを配置し、↓のコードにしてみてください。

Private Sub CommandButton1_Click()
Dim i As Long, j As Long, endCol As Long
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(i, "C") <> "" Then
endCol = Cells(i, Columns.Count).End(xlToLeft).Column
If endCol < 105 Then
j = 105
Else
j = endCol + 1
End If
Cells(i, "C").Resize(, 2).Copy Cells(i, j)
Cells(i, "C").Resize(, 2).ClearContents
If Cells(1, j) = "" Then
With Cells(1, j)
.Value = ((j + 2) Mod 105) / 2 & "回目の日"
.Offset(, 1) = ((j + 2) Mod 105) / 2 & "回目の履歴"
End With
End If
End If
Next i
End Sub

こんな感じではどうでしょうか？m（_ _）m

お礼

ありがとうございました。