エクセルVBAについての質問です。


Sheet1にあるF15に9999が入力されたのをイベントとして
Sheet1のA列、B列、C列を
Sheet2のA列、B列、C列にコピーしたいのです。
この時、Sheet1には数式が入っていますが
コピーしたいのは結果の数字のみです。
また、セルの中には数式は入っているが
結果は無いというセルがあるので
そういったセルはコピーしないで無視するということも行いたいです。

次に

エンターキーを三回連続で押した時、といったことを
VBAのイベントにできるのでしょうか。
この場合は、エンターキーを押す場所は
A列のセル上、F列のセル上のどちらかです。
(それぞれ動作は違う)

宜しくお願いいたします。

回答の条件
  • 1人10回まで
  • 登録:2006/07/21 11:14:09
  • 終了:2006/07/21 17:29:51

回答(4件)

id:gong1971 No.1

gong1971回答回数443ベストアンサー獲得回数682006/07/21 13:09:10

ポイント50pt

セルの中には数式は入っているが結果は無いというセルがあるので

これは、IF関数で "" を返しているセルは無視してという事でしょうか?

Excelでセルのコピーを行う場合、特定のセルを除いた分断した範囲を

そのままコピーする事は出来ないので、とりあえずコピーを行った上で

余計なデータを消去する方法が現実的です。


上記の条件の下で、とりあえずコードを書いてみました...

Sheet1のモジュールシートに下記のコードをコピーして下さい。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tmpcells As Range

    If Target.AddressLocal = "$F$15" Then
        If Target.Value = "9999" Then
            'このイベント中は別シートのセル選択が出来なかったので苦肉の策
              Sheets(Array("Sheet1", "Sheet2")).Select
            Range("A1").Select
            
            Sheets("Sheet1").Columns("A:C").Copy
            If Sheets.Count > 2 Then
                Sheets(3).Select
            End If
            Sheets("Sheet2").Select
            Selection.PasteSpecial Paste:=xlValues
            
            On Error Resume Next
            Selection.SpecialCells(xlCellTypeConstants, 2).ClearContents
            On Error GoTo 0
        End If
    End If

End Sub

※十分テストをした上でご利用下さい。

Sheet1のA:C列をコピーし、Sheet2のA:C列に値貼り付けを行い、

数値ではなく文字列が入力されたセルを消去しています。


ただし見出しなども消去してしまいます。例えば2行目まで見出しで

利用している場合は、下記の箇所を変更して下さい。

Selection.SpecialCells(xlCellTypeConstants, 2).ClearContents
↓
Sheets("Sheet2").Range("A3:C65536").SpecialCells(xlCellTypeConstants, 2).ClearContents

もし、データが少ないようであれば、セルの内容を1つ1つ確認して

1つずつデータを代入していく方法も有りだと思います。

もし、そちらの方法をご希望の場合は、以下の状況をお知らせ下さい。

  • 大体何行くらいまでデータがあるか?
  • 見出しに使用しているセルはあるか?その範囲は?
  • 必ずデータが入っている列はあるか?

なお、2つ目の質問については、ざっと見たところ無理そうな気が...。

もう少し調べてみますが、「無理です」という回答でもよいですか?

それなら回答しない方が良いですか?

id:e23jp

昨日に引き続きご回答いただき誠にありがとうございます。

B列が文字列なのでコピーできないようです。

それから、A列に9999がある時その行はコピーしないという設定は可能でしょうか

大体何行くらいまでデータがあるか?

→100行以上いくことは殆ど無い

見出しに使用しているセルはあるか?その範囲は?

→見出しは1行目のみ(A1:C1)

必ずデータが入っている列はあるか?

→9999を押された時点では(A2:C2)

二つ目の質問についてですが

無理であれば無理です

でもご回答いただければ助かります。

宜しくお願いいたします。

2006/07/21 14:52:08
id:freemann No.2

freemann回答回数315ベストアンサー獲得回数502006/07/21 15:36:00

ポイント50pt

2番目の質問について答えます。

かなりトリッキーなやり方で、もしかしたらご要望の利用方法では耐えられないかも知れませんが、一応こういうやり方があるということで載せておきます。

エンターキーが何回連続で押されたかを覚えておく変数をシートのモジュールレベルで宣言しておきます。

Private iCount As Integer

連続3回エンターキーが押されたら感知するということなので、どこかのセルの値が変更されたら、エンターキーのカウントを0にする。それとエンターキーが連続で押されるということなので、これは、セル移動が発生すると考えてアクティブセルが変わるということであると、とらえます。

Private Sub Worksheet_Change(ByVal Target As Range)

iCount = 0

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 1 Or Target.Column = 6 Then

iCount = iCount + 1

if iCount >= 3 then

'何かの処理

       '・・・・・

       'iCount = 0

End If

Else

iCount = 0

End If

End Sub

一応それらしい動きをすると思いますが、十字キーでの移動やマウスでのセル選択の動きでもカウントされるので・・・もしかしたら実用に耐えないかも知れません・・・

id:e23jp

ありがとうございます。

なるほどー、こういうやり方があるんですね。

参考になりました。

2006/07/21 16:33:06
id:gong1971 No.3

gong1971回答回数443ベストアンサー獲得回数682006/07/21 16:47:55

ポイント50pt

数百行程度のデータであれば、さほど時間が掛からないようなので、

セルを1つずつ確認して代入する方法の方が良さそうですね。

下記の通りコードを作成しました。

(A列に9999がある時は、その行はコピーしないようになってます。)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Integer
    Dim y As Long
    
    If Target.AddressLocal = "$F$15" Then
        If Target.Value = "9999" Then
            For y = 2 To Range("A1").SpecialCells(xlCellTypeLastCell).Row
                For x = 1 To 3
                    If Cells(y, x) = "" Or Cells(y, 1) = "9999" Then
                        Sheets("Sheet2").Cells(y, x).ClearContents
                    Else
                        Sheets("Sheet2").Cells(y, x) = Cells(y, x)
                    End If
                Next
            Next
        End If
    End If

End Sub

※十分テストをした上でご利用下さい。

ちなみに「結果が無いセル」と「A列に9999と入力されている行」は

コピーしないとの事ですが、Sheet2の該当セルに既にデータがある場合、

そのデータは消しますか?それとも保持したままにしますか?

上記コードは既存のデータを消すようにしています。

保持したい場合は、下記の記述を削除してください。

Sheets("Sheet2").Cells(y, x).ClearContents


2つ目の質問ですが、私が調べた限りでは有効な方法を見付ける事が

出来ませんでした。(何か方法はあるかもしれませんが...)


代替え案として、[Ctrl]キーと[Shift]キーを押しながら[Enter]キーを

押したらというのではいかがでしょうか?

標準モジュールに下記のプロシージャを追加します。

Private Sub Auto_Open()

    Application.OnKey "+^~", "test"

End Sub

Sub test()

    If ActiveCell.Column = 1 Or ActiveCell.Column = 6 Then
        'ここに処理内容を書きます。
    End If

End Sub

Auto_Openサブプロシージャはファイルを開いた際に自動実行される

プロシージャで、処理内容としては指定したキーが押された時に

指定のマクロを実行するように設定しています。


ちなみにキーの指定は[Backspace]の下の[Enter]キーで行っています。

テンキーの[Enter]キーの場合は指定文字が {ENTER} と異なります。

両方有効にしたい場合は下記の記述を追加、テンキーのみ有効にしたい

場合は下記の記述に書き換えてご利用下さい。

Application.OnKey "+^{ENTER}", "test"
id:e23jp

できました。完璧です。

二つ目の質問についてですが、

実はテンキーでのみの入力になると思うので

Ctrl+altは少し現実的ではないです。

今回は9999のほうでいこうと思います。

調べていただきありがとうございました。

何か別の機会のときに役立たせていただきます。

今回もわかりやすい解説と回答を誠にありがとうございました。

また機会があれば宜しくお願いいたします。

2006/07/21 17:29:13
id:freemann No.4

freemann回答回数315ベストアンサー獲得回数502006/07/21 17:12:42

ポイント10pt

セルを一つずつチェックしてコピーしていくタイプです。

F15に”9999”が設定されたとき、チェックするセルが多いので少し固まるので、想定される範囲があればループの数を減らすといいかもしれません。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Long

Dim j As Long

Dim lngData As Long

Dim strData As String

'設定されている数式がエラーのままの時のために必須

On Error Resume Next

If Target.Row = 15 And Target.Column = 6 And Target.Value = "9999" Then

For i = 1 To 3

For j = 1 To 65536

'セルに設定されている数式を取得

strData = Cells(j, i).Formula

If strData <> "" Then

'セルに数式が設定されている場合

lngData = Cells(j, i).Value

'設定されている数式が数値に変換されているか判定

'例えば =B6/C6 と設定されていてC6に値が無いときはエラーとなっている

If Err.Number = 0 Then

'数式がエラーじゃないとき

Worksheets(2).Cells(j, i).Value = lngData

Else

'数式がエラーの時はコピーしない

Err.Clear

End If

ElseIf Cells(j, i).Value <> "" Then

'ただの数値の場合はそのままコピー

Worksheets(2).Cells(j, i).Value = Cells(j, i).Value

End If

Next j

Next i

End If

End Sub

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません