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

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

これは、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つ目の質問については、ざっと見たところ無理そうな気が...。

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

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

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

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

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

	
Private iCount As Integer
	

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

	
	
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
	
	

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

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

セルを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"

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

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