[[20170117225027]] 『VBAで電卓のような処理を複数の列全体で行うには=x(しゅう) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『VBAで電卓のような処理を複数の列全体で行うには?』(しゅう)

VBAで電卓のような処理をしたいと思い、
http://www.excel.studio-kazu.jp/kw/20080328210605.html
http://www.excel.studio-kazu.jp/kw/20020530145644.html
参考にしたのですが、
B列の1〜60行までを入力スペースにして
答えをC列の1〜60行目それぞれに表示する。
同じことをD・E列、F・G列、H・I列と繰り返していくような
マクロを組むにはどうすれば良いでしょうか?

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim inp As Variant, outp As Variant
    Dim MyRng As Range
    Dim n As Variant

    On Error GoTo ERR_H

    inp = Array("C3", "C4", "C5", "C6", "E3", "G3")
    outp = Array("K3", "K11", "K12", "K13", "M3", "O3")

    Application.EnableEvents = False

    n = WorksheetFunction.Match(Target.Address(0, 0), inp, 0)
    Set MyRng = Range(WorksheetFunction.Index(outp, n))

    MyRng.Value = MyRng.Value + Target.Value
    If Target.Value <> "" Then
        Range(inp(n Mod (UBound(inp) + 1))).Select '(1)
 '      Target.Select                              '(2)
    Else
        MyRng.Value = 0
    End If

 ERR_H:
    Application.EnableEvents = True

 End Sub

をもとにいろいろ試してみたのですがどうしても列全体を選択する方法が分からず…
詳しい方よろしくお願いしますm(_ _)m

< 使用 Excel:Excel2013、使用 OS:Windows7 >


 >>同じことをD・E列、F・G列、H・I列と繰り返していくような 

 H・I 『まで』ですか? それとも、延々とそのあと、J・K、L・M、・・・・ と続くのですか?

 あと、アップされたコードでは入力後、空白ではなかったらカーソルを、『次の入力セル』にもっていってますね。

 今回のテーマでは、たとえばB1に入力した場合、次のセルはどこでしょう?
 B2ですか? D1 ですか?

(β) 2017/01/18(水) 06:24


コメントありがとうございます。

>H・I 『まで』ですか? それとも、延々とそのあと、J・K、L・M、・・・・ と続くのですか?

セルはT列まで続きます。

入力セルですが、B1に入れたらB2、B3と続いていき
列の最後(B60)までいったら次の列に飛んでD1、D2…という感じで続いていきます。
(しゅう) 2017/01/18(水) 08:14


 一例です。

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a As Range
    Dim r As Range
    Dim c As Range
    Dim n As Range
    Dim sCell As Range
    Dim zCell As Range

    Set a = Range("B:B,D:D,F:F,H:H,J:J,L:L,N:N,P:P,R:R,T:T")
    Set a = Intersect(a, Rows("1:60"))

    Set r = Intersect(Target, a)
    If r Is Nothing Then Exit Sub

    Application.EnableEvents = False

    For Each c In r
        If IsEmpty(c) Then
            c.Offset(, 1).Value = 0
        Else
            If IsNumeric(c) Then
                c.Offset(, 1).Value = Val(c.Offset(, 1).Value) + c.Value
                Set n = c
            End If
        End If
    Next

    '次のセル
    If Not n Is Nothing Then
        Set sCell = a.Cells(1)
        Set zCell = a.Areas(a.Areas.Count).Cells(a.Areas(a.Areas.Count).Count)

        If n.Address = zCell.Address Then   '最終セル
            sCell.Select    '最初のセル
        Else
            If n.Row = zCell.Row Then
                n.Offset(, 2).EntireColumn.Cells(sCell.Row).Select
            Else
                n.Offset(1).Select
            End If
        End If
    End If

    Application.EnableEvents = True

 End Sub

(β) 2017/01/18(水) 09:11


βさん

上のコードを入力したら上手くいきました!
本当にありがとうございました(^o^)

(しゅう) 2017/01/18(水) 12:47


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.