締切済み

エクセル2003でダブルクリック処理でエラーをしてしまう

2009/03/04 14:22

エクセルのシートＡからＺまであります一部計算式が入っているのデーター処理が終了後にダブルクリックでコピー＆値の貼り付けで式をなくしていますが列の一部とフィルターをかけると処理ができずにエラーをしてしまい対処方法が分かりません初心者でエラーの意味すら分からないのですが選択した領域と貼り付ける領域が違うようなのですどこを直せばよいのか教えて下さい。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim RangeName As String RangeName = Target.Address RangeName = Mid(RangeName, 2, 1) If RangeName = "Z" And Target = "" Then Target = "OK" Range(Cells(Target.Row, 1), Cells(Target.Row, 27)).Copy ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range(Cells(Target.Row, 1), Cells(Target.Row, 27)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 End If End Sub 宜しくお願いします。

sbym43
お礼率100% (3/3)

オフィス系ソフト
回答数3
ありがとう数3

みんなの回答 （3）
専門家の回答

みんなの回答

hige_082
ベストアンサー率50% (379/747)

2009/03/10 17:08 回答No.3

＃１、＃２ですこちらのエクセルが２０００だからなのか、エラーが再現できないのですが非表示を解除すると、できるということですので非表示解除、コピペ、非表示設定としてみましたのでよければ試してみてください Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim RangeName As Long Dim RangeHidden(1 To 26) As Boolean Dim i As Long Application.ScreenUpdating = False RangeName = Target.Column If RangeName = 26 And Target = "" Then Target = "OK" For i = 1 To 26 RangeHidden(i) = Columns(i).EntireColumn.Hidden Next Columns("A:Z").EntireColumn.Hidden = False Range(Cells(Target.Row, 1), Cells(Target.Row, 26)).Copy Cells(Target.Row, 1).PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False For i = 1 To 26 Columns(i).EntireColumn.Hidden = RangeHidden(i) Next End If Application.ScreenUpdating = True End Sub

質問者

お礼 2009/03/11 23:15

ありがとうございます。うまく動きました。感動です

hige_082
ベストアンサー率50% (379/747)

2009/03/05 00:41 回答No.2

＃１です＃１も軽く修正もしていたのですが、一部間違いもあったので再度、修正しました Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim RangeName As Long RangeName = Target.Column If RangeName = 26 And Target = "" Then Target = "OK" Range(Cells(Target.Row, 1), Cells(Target.Row, 26)).Copy Cells(Target.Row, 1).PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End If End Sub これ、試してみて

質問者

お礼 2009/03/09 09:35

お礼が遅くなりまして申し訳ありません何度も考えて頂き誠にありがとうございました。結果はうまくいきませんでしたが列を非表示にしなければうまく動きますのでこちらで使用していきます。ありがとうございました。

hige_082
ベストアンサー率50% (379/747)

2009/03/04 15:50 回答No.1

どんなエラーが出るのか分からないと対処の使用がありません列の一部？をどうしたのでしょう Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim RangeName As Long RangeName = Target.Column If RangeName = 26 And Target = "" Then Target = "OK" Range(Cells(Target.Row, 1), Cells(Target.Row, 27)).Copy Cells(Target.Row, 1).PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End If End Sub 一応、コードを整理してみました

質問者

お礼 2009/03/04 17:22

早速のご回答を有り難うございます。説明が不足してまして申し訳ありませんです。 ”列の一部？をどうしたのでしょう” 何列か(C,D,Gの列）を非表示にしているのですオートフィルターで絞り込んでダブルクリックをすると実行時エラーになってしまいますコピーを選択範囲と貼り付けの領域が性格に同じでないと目的の貼り付けを行えません。と返してきます。列をすべて表示すると実行できるのですがどこを直せばよろしいのでしょうか？

関連するQ&A

Excel VBA で1時的に右クリックを使いたい
30枚ほどのシートの表を一挙に変更したいです。ところが、各シートに次のコードが入っているため、右クリックしてコピーとか一切使えません。各シートの変更ができるまで、右クリック使いたいです。何か方法ありませんでしょうか？ ' 画面の一番上表示 Dim hr As Range Set hr = Range("A1") '左上隅セルを設定 ActiveWindow.ScrollRow = hr.Row '行の一番上にスクロール ActiveWindow.ScrollColumn = hr.Column '列の一番左にスクロール End Sub Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Cancel = True 'プロシージャ終了後に表示されるショートカットメニューの非表示 If Target.Row > 14 And Target.Row < 45 And Target.Column > 13 And Target.Column < 15 Then 明細入力フォーム.Show End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 1 And Target.Column < 3 Then Call ShowCalendarFromRange2(Target) End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 3 And Target.Column < 5 Then Call ShowCalendarFromRange2(Target) End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 5 And Target.Column < 7 Then Call ShowCalendarFromRange2(Target) End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 8 And Target.Column < 10 Then Call ShowCalendarFromRange2(Target) End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 2 And Target.Column < 4 Then UserForm3.Show End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 4 And Target.Column < 6 Then UserForm3.Show End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 6 And Target.Column < 8 Then UserForm3.Show End If If Target.Row > 36 And Target.Row < 44 And Target.Column > 9 And Target.Column < 11 Then UserForm3.Show End If End Sub
- ベストアンサー
- Excel（エクセル）
エクセル　ダブルクリックで処理日の入力
お世話になります。先般、お教え頂きました別のダブルクリックイベントプロシージャと下記の当日の日付を入力するという処理を同じシート上で行いたいのですが、ＶＢエディターにどのように記述したら良いかわかりません。当方、かなりの初心者です。よろしくご教授くださいませ。【新しく加えたい処理】 Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("b4:C999")) Is Nothing Then Exit Sub If ActiveCell = "" Then ActiveCell = Date Cancel = True End If End Sub 【もともと使っている処理】 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("h1:h999")) Is Nothing Then With Target If .Value = "" Then .Value = "有" ElseIf .Value = "有" Then .Value = "無" ElseIf .Value = "無" Then .Value = "" End If End With ElseIf Not Intersect(Target, Range("i1:i999")) Is Nothing Then With Target If .Value = "" Then .Value = "要" ElseIf .Value = "要" Then .Value = "不要" ElseIf .Value = "不要" Then .Value = "" End If End With End If End Sub よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
エクセル　VBA　繰り返し処理を　簡潔にしたいのでお願いします。
初心者です。繰り返し処理のシート名操作が分かりません。上手く説明できないのですが、シートの名前が数字の1～20で特定のセルを参照してテーブルにします。現在、とても単純なコードを繰り返しています。すっきりとさせるには、どのように記載するとよいのか教えてください。以下の処理を20回ほど繰り返します。　'シート１の特定セルをコピーします Sheets("1").Range("c3").Copy Range("A3").PasteSpecial Sheets("1").Range("c4").Copy Range("B3").PasteSpecial Sheets("1").Range("o2").Copy Range("C3").PasteSpecial Sheets("1").Range("o3").Copy Range("D3").PasteSpecial Sheets("1").Range("Q6:Q42").Copy Sheets("集計").Select ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("E3").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True 'シート２の特定セルをコピーします Sheets("2").Range("c3").Copy Range("A4").PasteSpecial Sheets("2").Range("c4").Copy Range("B4").PasteSpecial Sheets("2").Range("o2").Copy Range("c4").PasteSpecial Sheets("2").Range("o3").Copy Range("d4").PasteSpecial Sheets("2").Range("Q6:Q42").Copy Sheets("集計").Select ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("E4").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Sheets("3").Range("c3").Copy Range("A5").PasteSpecial Sheets("3").Range("c4").Copy Range("B5").PasteSpecial Sheets("3").Range("o2").Copy Range("c5").PasteSpecial Sheets("3").Range("o3").Copy Range("d5").PasteSpecial Sheets("3").Range("Q6:Q42").Copy Sheets("集計").Select ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("E5").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True
- ベストアンサー
- オフィス系ソフト
エクセルＶＢＡについて
http://okwave.jp/qa/q7236213.html 上記質問の発展形なのですが同様のことをＥ列に日付Ｆ列に売上Ｇ列に結果でやりたいのですがこの時Ａ列～Ｃ列のマクロも残したままでしたいのですが下記のように同様のプロシージャーを下段に書けばできると思ったのですがうまくいきません。 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$A$1" Then Exit Sub If Target = "" Then Exit Sub Range("C10:C65536").ClearContents With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) .FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" .Value = .Value End With End Sub Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$E$1" Then Exit Sub If Target = "" Then Exit Sub Range("G10:G65536").ClearContents With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) .FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" .Value = .Value End With End Sub どなたかお知恵を拝借できませんでしょうか？
- ベストアンサー
- オフィス系ソフト
エクセルＶＢＡで最小値を求めたいのですが
下記はある表の最大値を求めるものですが同様の条件で最小値を求めようと思い「MAX」の箇所を「MIN」差し替えてできると思っていたのですが最小値がのかわりに「0」が表示されてしまいます。そのように修正すればよいでしょうか？ private sub worksheet_change(byval Target as excel.range) 　if target.cells(1) = "" then exit sub 　if target.address = "$A$1" then 　　Range("C10:C65536").ClearContents 　　With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) 　　　.FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" 　　　.Value = .Value 　　End With 　elseif target.address = "$E$1" then 　　Range("G10:G65536").ClearContents 　　With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) 　　　.FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" 　　　.Value = .Value 　　End With 　end if end sub
- ベストアンサー
- オフィス系ソフト
エクセルで選択中の列や行を見やすくしたい
タイトルのとおり、選択中の列や行の色が一列全部変るようにしたいと思い調べ、以下のＶＢＥコードを見つけたんですが Public m Private Sub Worksheet_SelectionChange(ByVal Target As Range) 　If m <> 0 Then 　　Range(Cells(m, 1), Cells(m, 256)).Interior.ColorIndex = xlNone 　End If 　Range(Cells(Target.Row, 1), Cells(Target.Row, 256)).Interior.ColorIndex = 6 　m = Target.Row End Sub 確かに色は変るんですが、もともとついている箇所の色が消えていってしまいます。色が消えずに同じことは出来ないでしょうか。ご存知の方いらっしゃいましたら教えてください。よろしくお願いします。
- ベストアンサー
- その他([技術者向] コンピューター)
エクセルで、こうやっても反応なしです。
よろしくお願いします。以下のように組んで見ました。 Private Sub Worksheet_Change(ByVal Target As range) Dim clm As Integer Dim row As Integer clm = Target.Column row = Target.row If Worksheets("発注指示").Cells(row, clm) = "不足" Then MsgBox "在庫不足", vbOKOnly, "注意" End If End Sub どうして動かないのでしょう。本当にわからないので、教えてください。これで一日つぶれました。
- ベストアンサー
- Visual Basic
２つのVBAを組み合わせる方法
お世話になります、２つのVBAを組み合わせる方法で迷っています。１つ目が Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True End Sub です。２つめが Private Sub Worksheet_Change(ByVal Target As Range)　 Application.EnableEvents = True If Intersect(Target, Range("R8:R38")) Is Nothing Then Exit Sub Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End Sub です。２つのPrivate Sub Worksheet_Change(ByVal Target As Range)イベントのVBAですが、どのようにして組み合わせれば良いのでしょうか？
- ベストアンサー
- Excel（エクセル）
VBAでの処理分岐方法を教えてほしいです
VBAの分岐処理で悩んでおります。誰かお助けお願いします。 A列に昇順で番号があります。 1 2 4 4 5 6 9 欠番や重複した数値があります。やりたいことは欠番箇所に行を挿入し、連番にしたいです。この例で言うと、3行目に1行を挿入し番号を3と入れる、6行目に2行挿入し7,8と連番にする。連番になった後に、重複した数値に色を付けます。以下私が作成したコードです。callで呼び出す予定です。 Sub 欠番判定数式() Dim i As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Cells(i, 3) = "=if(iserror(if(A" & i & "-A" & i - 1 & ">1,""○"","" "")),"""",if(A" & i & "-A" & i - 1 & ">1,""○"","" ""))" Next End Sub Sub 行挿入() Dim c As Range, Target As Range For Each c In Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row) If c = "○" Then If Target Is Nothing Then ''(1) Set Target = c Else Set Target = Union(Target, c) ''(2) End If End If Next c If Not Target Is Nothing Then Target.Select Selection.EntireRow.Insert , copyorigin:=xlFormatFromLeftOrAbove End Sub Sub 空白連番入力() Dim i As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 1) = "" Then Cells(i, 1) = (Cells(i, 1).Offset(1, 0).Value) - 1 End If Next End Sub Sub 番号重複確認() Dim i As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Application.WorksheetFunction.CountIf(Range("$A$2:$A$" & Cells(Rows.Count, 1).End(xlUp).Row), Range("A" & i)) <> 1 Then Cells(i, 1).Interior.ColorIndex = 3 End If Next End Sub このコードを順に全て実行した時、1回目の処理で3行目と5行目に行挿入、そして番号が3と7と入力され連番に色が設定されます。再度「欠番判定数式」を行い、次は8行目に行挿入し8と連番を入力させ処理を繰り返しさせたいです。欠番は例として最高2個にしてますが、これから2個以上の可能性もあります。一度全処理終了後、再度最初の処理（欠番判定数式）に戻り、欠番がある場合は行挿入させという処理を行わせ、欠番がない場合は次の処理に進めるという分岐方法を教えてほしいです。よろしくお願いいたします
- ベストアンサー
- Visual Basic
excel vba ジャンプ
excel2003のUserFormにてtextbox作成しました。 textbox1にページを入力すると指定のページにジャンプするコードを作成したのですが、動作的には目的とする事ができました。ただ、初心者レベルで作成したので、コード記述が長く、ページが増えるたびにコードを追記していかなければなりません。下記に作成したコードを記述します。もっと簡単に記述する方法はありますか？ ---------------------------------------------------------- Private Sub TextBox1_Change() If TextBox1.Value = 1 Then ActiveWindow.ScrollRow = 1 ActiveWindow.ScrollColumn = 1 Range("$A$15").Select End If If TextBox1.Value = 2 Then ActiveWindow.ScrollRow = 38 ActiveWindow.ScrollColumn = 1 Range("$A$38").Select End If If TextBox1.Value = 3 Then ActiveWindow.ScrollRow = 69 ActiveWindow.ScrollColumn = 1 Range("$A$69").Select End If If TextBox1.Value = 4 Then ActiveWindow.ScrollRow = 100 ActiveWindow.ScrollColumn = 1 Range("$A$100").Select End If If TextBox1.Value = 5 Then ActiveWindow.ScrollRow = 131 ActiveWindow.ScrollColumn = 1 Range("$A$131").Select End If End Sub ---------------------------------------------------------- 上記記述で行っていることは、 textbox1に　1　と入力すると1ページ目が表示　キーボードでctrl+Homeの操作をした状態でカーソルがA15選択 textbox1に　2　と入力すると2ページ目が表示　表示の先頭が38行目、カーソルがA38選択ページの行数が1ページ目だけ37行 2ページ目以降が31行ごとです。実際は、200ページ以上あるのでなんとかしたいのですが・・・・
- ベストアンサー
- オフィス系ソフト

エクセル2003でダブルクリック処理でエラーをしてしまう