スピンボタンのコピー

質問

よろしくお願いします。

ある項目の数を数えるのに、スピンボタンを利用しています。
増えたり減ったりするごとにすぐ横の列にあるスピンボタンを押し、増減させています。
ただ、なにぶん数が多くて、いちいちコピーして、リンク先のセルを手動で入力したりするのが面倒です…。
数百項目分のスピンボタンをコピーし、１行から数百行分までリンク先もバッチリコピー！
という方法はないでしょうか？

回答No.4

fumufumu_2006 · ベストアンサー

>C4：C1000　J4：J1000
>といったような二つの列の範囲のみで効果を発揮したいのです。
>出来る限り自分で、と思っていろいろ試しましたがうまくいきません。

>回答ありがとうございました。
>とても参考になりました。
>さっそく導入してみます。

解決したんでしょうか?
下は、最初からシートにスピンボタンを配置した場合の複数範囲のです。
targetRangeでスピンボタンの出る範囲を指定しておいてください。
シートに前もってスピンボタン(SpinButton1)を配置しておいてください。

Option Explicit
Const targetRange = "C4:C1000,J4:J1000" 'スピンボタンを表示する場所
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With SpinButton1
If Not Intersect(Target, Range(targetRange)) Is Nothing Then
.Visible = True
.LinkedCell = Target.Address
.Top = Target.Top
.Left = Target.Left + Target.Width
Else
.Visible = False
End If
End With
End Sub

別の方法ですが、スピンボタンだと２アクションになるので、ダブルクリックと右クリックの方法です。
Option Explicit
Const targetRange = "C4:C1000,J4:J1000" 'スピンボタンを表示する場所
'ダブルクリックは+1
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range(targetRange)) Is Nothing Then
Target = Target + 1
Cancel = True
End If
End Sub
'右クリックは-1
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range(targetRange)) Is Nothing Then
Target = Target - 1
Cancel = True
End If
End Sub

また、スピンボタンを出す条件を、
If Not Intersect(Target, Range(targetRange)) Is Nothing Then
から
If Target.Interior.ColorIndex = 6 Then
に変えると、背景色が黄色のセルならスピンボタンを出すと言うのもできます。
この方法は、複数のランダムな位置のセルを指定する場合や、シートの設計が変わる場合に有効だと思います。

お礼

わざわざありがとうございます。
教えていただいたサイトの方法で、
If Intersect(Range("C4:H10000"), Target) Is Nothing Or Target.Cells.Count > 1 Then

の部分で
Union(Range("C4:C1000"),Range("J4:J1000"))
のようにするとなんとかなりました。
ありがとうございました。

回答No.3

imogasi

多分質問のようなたくさんのコントロールを作らなくても
ワークシートSheet1に１つスピンボタンを張り付け（SpinButton1）
Private Sub SpinButton1_Change()
Worksheets("Sheet1").SpinButton1.LinkedCell = ActiveCell.Address
Range(ActiveCell.Address).Select
End Sub
をSheet1のイベントプロシジュアーにつくる。
ーー
操作
カウントアップやダウンしたいセルを選択して、アクチブにする。
そしてスピンボタンをクリックする。増減することを確認してください。
別のセルをアクチブにすると、前のアクチブセルでは増減しない。
ーー
Activeセルの範囲をA列等に限定して、どこのセルでも上記になることを防ぐ。
上記を改良。
Private Sub SpinButton1_Change()
If ActiveCell.Column <> 1 Then
Worksheets("Sheet1").SpinButton1.LinkedCell = ""
Exit Sub
Else
Worksheets("Sheet1").SpinButton1.LinkedCell = ActiveCell.Address
Range(ActiveCell.Address).Select
End If
End Sub
アクチブセルの動きによるスピンボタンの異表示位置移動が、未実現。

お礼

質問の内容が正確ではなかったのに、回答いただいてありがとうございました。
いろいろ試してみることにします！
VBAは完全に初心者なので、投稿いただいた内容の理解からまず始めたいと思います（＾＾；

回答No.2

fumufumu_2006

こんなのどうでしょう。
http://www4.ocn.ne.jp/~yy3/Sub56.html
現実的です。

お礼

回答ありがとうございました。
とても参考になりました。
さっそく導入してみます。

補足

すいません、回答いただいた内容をさっそく試してみましたが、うまくいきません…。
教えていただいたマクロですと、C4:H10000　というような範囲ですが、
C4：C1000　J4：J1000
といったような二つの列の範囲のみで効果を発揮したいのです。
出来る限り自分で、と思っていろいろ試しましたがうまくいきません。
自分はVBA初心者でなにもわかってないようです…。

回答No.1

pbforce

やりたいこと(ご質問の内容)があまり良く理解できないのですが、VBAを使用すれば可能ではないでしょうか？

ただ、スピンボタンにこだわるような事ではないかもしれませんね。どうしてもスピンボタンがいいと言うのでなければ、もっと簡単な方法がありそうです。

全体的な動作や、どのようなものが必要なのか教えてください。

補足

ご回答ありがとうございます。
質問内容が適切でなくて、すいません…。
たとえば、1000種類ほどの商品等があって、それがいちいち増える（減る）ごとに数を記録したい、ということです。
前までは直接数字を打ち込んでいたのですが、スピンボタンがいいかと思って改良しているところです…。
A列などに商品項目名、B列にスピンボタン、C列にその数、といった具合です。
スピンボタンにこだわるわけではありませんが、利便性と正確性が上がる方法を模索中です！
よろしくお願いします。