はじめての親子ハイキングに挑戦!! >>

エクセルでセルをダブルクリックしたらそのブックの別のシートに飛び
とんだ先のシートにダブルクリックしたところのセルと同じものを記入する
といったような動作はVBAでは可能でしょうか。
すみませんが教えて頂きたいです
よろしくお願いいたします

A 回答 (4件)

別にマクロの品評会でもありませんが、こんなコードになります。


マクロ禁断のSelect を使った特殊な例です。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Dim sh2 As Worksheet
 If Target.Value = "" Then Exit Sub
 Set sh2 = Worksheets("Sheet2") '目的のシート
 Cancel = True 'これは忘れないこと。おまじない
 Me.Select False
 sh2.Select False
 Target.Select
 Selection.Value = Selection.Value '* 
 Me.Select
End Sub

'数式の場合
 'Selection.FormulaLocal = Selection.FormulaLocal
    • good
    • 0

下記のマクロをSheet1のシートモジュールに張り付けて下さい。


Sheet1の任意のセルをダブルクリックするとSheet2に飛びます。
飛び先は、Sheet2のアクティブセル(最後に選択されていたセル)です。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Sheets("Sheet2").Select
ActiveCell.Value = Target.Value
End Sub
    • good
    • 1

回答が無い様なので。


Sheet1のセルをダブルクリックしたら、Sheet2の同じセルに代入する。
Sheet1のprivate subをして作りこみます。


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")

行 = Target.Row
列番号 = Target.Column
列 = Split(Cells(Target.Column).Address, "$")(1)

Sheets("Sheet2").Activate 'Sheet2をアクティブ
Sh2.Range(列 & Target.Row).Activate 'Sheet2のセルをアクティブ

Sh2.Range(列 & Target.Row) = Sh1.Range(列 & Target.Row) '代入

End Sub
    • good
    • 0

回答が無いようですので・・・



>~~といったような動作はVBAでは可能でしょうか。
内容がはっきりしないので正確ではないけれど、多分可能だろうと思いますよ。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aと関連する良く見られている質問

Q<エクセル>2つのデータに間違いがないかをチェックしたい

エクセルで入力したデータが、ルールに基づいて正しく入力できているかどうかを確認するような関数はありますか?

例として(添付画像もつけさせていただきました)「粉薬」と「飲薬」を入力し、各容量を入力します。
「粉薬」と「××g」、「飲薬」と「××」は必ずセットで入力されていることが必須です。
もし誤って「粉薬」のときに「××」と入力をした場合に、間違った入力がされていることが表示されるような関数はありますでしょうか?
枠外に〇や×として表示される
セルに色がつく・・・等

色々検索をして試してみたのですがうまくいきません。
VBAなども出てきたのですが私自身知識が全くないことと、作成したデータをあまりエクセルが得意ではない人が使う可能性などを考え、できれば関数などでできれば・・・と考えています。

Aベストアンサー

=IF(NOT(ISERROR(FIND("粉薬",B2))),IF(NOT(ISERROR(FIND("g",C2))),"○","×"),"・")
b2に粉薬の文字がある場合で、かつ、(c2にgの文字がある場合には、○を表示、ない場合は×を表示)、左記以外は・を表示

Qエクセルデータをカンマ区切り、ダブルコーテーションで囲んだデータにする方法を教えてください

はじめまして。
仕事でエクセルデータをカンマ区切り、ダブルコーテーション囲みのテキストデータにする必要があります。

例)
”111”,"222","","","","666""

このように空白のセルもあり、そのセルもダブルコーテーションで囲みたいです。
VBAで変更する方法をどこかで見かけましたが、張り付けてみましたが、上手く動きませんでした。
超初心者ですので、わかりやすく教えていただけると有り難いです。

お手数をおかけしますが、宜しくお願い致します。

Aベストアンサー

Unicode 出力の件ですが、せっかく、個人用マクロブックに納められる(つもり)ので、それを、書き換えるよりも、後づけマクロのほうがよいかもしれません。一緒にしてしまうと、Unicodeのみになってしまいますから、それも望まないし……
とあれこれ考えて、単独マクロで、Unicodeファイル判別するプログラムもつけました。BigEndien も LittleEndienも別けますが、出力は、BigEndienだけです。
こういうのは、余計なものかもしれません。

'//
Public Sub Convert2UNICODE()
'シフトJISをUnicodeに替えるマクロ
Dim stream As Object
Dim stream2 As Object
Dim fname As Variant
Dim buf As Variant
Dim b() As Byte
Dim i As Long
fname = Application.GetOpenFilename _
 ("File (*.*), *.*", 1, "ファイルオープン")
 If VarType(fname) = vbBoolean Then Exit Sub
 Open fname For Binary As #1
   ReDim b(1 To 6)
    Get #1, , b
  Close #1
 For i = 1 To 6
 buf = buf & Hex(b(i))
 Next
 If buf Like "FFFE*" Or buf Like "FEFF*" Then
  MsgBox "ファイルはすでにUnicodeです。", vbExclamation
  Exit Sub
 End If
 '-------変換プログラム-----------
On Error GoTo ErrHandler
Set stream = CreateObject("ADODB.Stream")
  stream.Open
  stream.Type = 2
  stream.Charset = "shift_jis"
  stream.LoadFromFile fname

Set stream2 = CreateObject("ADODB.Stream")
  stream2.Open
  stream2.Charset = "unicode"
  stream.CopyTo stream2
  stream2.SaveToFile (fname), 2
  stream2.Close
  stream.Close

Set stream2 = Nothing
Set stream = Nothing
Exit Sub
ErrHandler:
 If Err.Number <> 0 Then 
  Msgbox Err.Number & " :" & Err.Description
End If
End Sub

Unicode 出力の件ですが、せっかく、個人用マクロブックに納められる(つもり)ので、それを、書き換えるよりも、後づけマクロのほうがよいかもしれません。一緒にしてしまうと、Unicodeのみになってしまいますから、それも望まないし……
とあれこれ考えて、単独マクロで、Unicodeファイル判別するプログラムもつけました。BigEndien も LittleEndienも別けますが、出力は、BigEndienだけです。
こういうのは、余計なものかもしれません。

'//
Public Sub Convert2UNICODE()
'シフトJISをUnicodeに替えるマクロ
Di...続きを読む

QExcelを使って行列変換をしたい(大量件数)

先日質問させていただいたものです。
さらなる加工が必要になりました。

例えば、
◆test
aaaaaa
iiiiiiiiiiiii
uuuuu
eeeee
ooooo
◆test2
kaaaaa
kiiiiiiiiiii
kuuuuu
keeeee
kooooo
...

これらのデータを
◆test aaaaaa
    iiiiiiiiiiiiii
    uuuuuu
eeeeee
oooooo
◆test2 kaaaaa
     kiiiiiiiiiii
     kuuuu
     keeeee
     koooooo

に変換はできたのですが、今度は
◆test aaaaaaaa iiiiiiiiiii uuuuuuuuuuu eeeeeee oooooo
◆test2 kaaaaaa kiiiiiiiii kuuuuuuuuu keeeeee koooooooo

のように変換する必要がでてしまいました。

マクロなどで一括で変換できないでしょうか。
当方知識が乏しいため困っております。

先日質問させていただいたものです。
さらなる加工が必要になりました。

例えば、
◆test
aaaaaa
iiiiiiiiiiiii
uuuuu
eeeee
ooooo
◆test2
kaaaaa
kiiiiiiiiiii
kuuuuu
keeeee
kooooo
...

これらのデータを
◆test aaaaaa
    iiiiiiiiiiiiii
    uuuuuu
eeeeee
oooooo
◆test2 kaaaaa
     kiiiiiiiiiii
     kuuuu
     keeeee
     koooooo

に変換はできたのですが、今度は
◆test aaaaaaaa iiiiiiiiiii uuuuuuuuuuu eeeee...続きを読む

Aベストアンサー

こんにちは!

別シートに表示しても良いですか?
元データはSheet1のA列にあり、Sheet2に表示するとします。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
If InStr(.Cells(i, "A"), "◆") > 0 Then
cnt = cnt + 1
wS.Cells(cnt, "A") = .Cells(i, "A")
Else
wS.Cells(cnt, Columns.Count).End(xlToLeft).Offset(, 1) = .Cells(i, "A")
End If
Next i
End With
End Sub

こんな感じではどうでしょうか?m(_ _)m

こんにちは!

別シートに表示しても良いですか?
元データはSheet1のA列にあり、Sheet2に表示するとします。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
If InStr(.Cells(i, "A"), "◆") > 0 Then
cnt = cnt + 1
wS.Cells(...続きを読む

QExcelについて教えて頂きたいのですが。縦に1~10行あり、名前あり、例えば5番目の方が休みの時に

Excelについて教えて頂きたいのですが。縦に1~10行あり、名前あり、例えば5番目の方が休みの時に自動的に5番目の行の所に下から詰める方法はありますか?

Aベストアンサー

配列の確定をしない場合、こんなふうにできます。

=IFERROR(INDEX($A$1:$B$11,SUMPRODUCT(SMALL(ROW($A$1:$A$11)+($B$1:$B$11<>"")*100,ROW(A1))),1),"")

注意点
=IFERROR(INDEX($A$1:$B$11,
  $A$1:$B$11 ←全体の範囲/1行目から始まる
  
SUMPRODUCT(SMALL(
ROW($A$1:$A$11)+($B$1:$B$11<>"")*100,
  $A$1:$A$11 ,$B$1:$B$11 ←1行目から始まる

ROW(A1))),1),"")

つまり、計算上で出てくる「0値」の追い出しですね。

QVBAで抽出とコピペのループがうまくいかない?

Excel2010のVBAに詳しい方、至急です。
前回も同様の質問をして、回答していただいた方のアドバイスをもとに自分でも改善?してみたつもりなのですが無理だったので再度質問させていただきます。

ポケモン図鑑という表をタイプごとにリストを抽出して、
そのデータをA列に数値が入っている行から最後の行までをコピーして、
抽出した際の条件と同じ名前のシートに所定の場所に貼り付け、最後に貼り付け先のシートのとある箇所をコピーして、ポケモン図鑑というシートにデータをペーストするというマクロなんですが、実際に通しても数値が0となってしまいます。
メッセージボックスで入力した後、「終了しました」と出るのですが期待通りに抽出してコピー&ペーストができていないようで困っています。
だれかたすけていただけませんか。

※抽出する項目
lightening※1
fire※2
water
leaf
wind
dragon

※1抽出する際、テキストフィルターのユーザー設定で
「lightening」からはじまる「伝説・幻」を含まないという条件で抽出しなければならない。
※2抽出する際、テキストフィルターのユーザー設定で
「fire」からはじまる「伝説・幻」を含まないという条件で抽出しなければならない。

Sub Pokemon()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim hizuke As String, wnum As String
Dim rng As Range
Dim i As Long, imax As Long
Dim j As Variant, c As Long
Dim sname As String
Dim fsh As Variant
fsh = Array("lightening", "fire", "water", "leaf", "wind", "dragon")
hizuke = InputBox("ポケモンを捕まえた日付を入力して下さい")
If hizuke = "" Then Exit Sub
If IsDate(hizuke) = False Then
MsgBox "日付不正"
Exit Sub
End If
Set sh1 = Worksheets("ポケモン図鑑")
With sh1
Set rng = .Range(.Cells(4, 5), .Cells(4, .Cells(4, Columns.Count).End(xlToLeft).Column))
End With
j = Application.Match(CLng(CDate(hizuke)), rng, 0)
If IsError(j) Then
MsgBox "該当日付がありません"
Exit Sub
End If
wnum = InputBox("選択した日付が何週目になるかを入力して下さい")
If wnum = "" Then Exit Sub
If wnum < 1 Or wnum > 5 Then
MsgBox "週不正"
Exit Sub
End If
Application.ScreenUpdating = False
c = wnum * 2 + 3
For Each sh2 In Worksheets
For i = 0 To 5
If sh2.Name = fsh(i) Then
With sh2
If .Cells(5, c) <> "" Then
.Range(.Cells(5, c), .Cells(.Cells(Rows.Count, c).End(xlUp).Row, c)).ClearContents
End If
End With
Exit For
End If
Next i
Next sh2
With sh2
If .Cells(5, c) <> "" Then
.Range(.Cells(5, c), .Cells(.Cells(Rows.Count, c).End(xlUp).Row, c)).ClearContents
End If
End With
End If
Next sh2
With sh1
imax = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 6 To imax
If .Range("A" & i).Value <> "" Then
sname = .Range("D" & i).Value
Select Case sname
Case "lightening","fire","water", "leaf", "wind", "dragon"
Case Else
sname = ""
End If
End Select
If sname <> "" Then
Set sh2 = Worksheets(sname)
sh2.Cells(sh2.Cells(Rows.Count, c).End(xlUp).Row + 1, c).Value = .Cells(i, j + 4)
End If
End If
Next i
For i = 32 To 40
Set sh2 = Nothing
Select Case i
Case 1
Set sh2 = Worksheets("lightening")
Case 2
Set sh2 = Worksheets("fire")
Case 4
Set sh2 = Worksheets("water")
Case 6
Set sh2 = Worksheets("leaf")
Case 7
Set sh2 = Worksheets("wind")
Case 9
Set sh2 = Worksheets("dogagon")
End Select
If Not sh2 Is Nothing Then
.Cells(i, j + 4).Value = sh2.Cells(sh2.Cells(Rows.Count, c + 1).End(xlUp).Row, c + 1).Value
End If
Next i
End With
Application.ScreenUpdating = True
MsgBox "ポケモン抽出コピペ終わり!"
End Sub

Excel2010のVBAに詳しい方、至急です。
前回も同様の質問をして、回答していただいた方のアドバイスをもとに自分でも改善?してみたつもりなのですが無理だったので再度質問させていただきます。

ポケモン図鑑という表をタイプごとにリストを抽出して、
そのデータをA列に数値が入っている行から最後の行までをコピーして、
抽出した際の条件と同じ名前のシートに所定の場所に貼り付け、最後に貼り付け先のシートのとある箇所をコピーして、ポケモン図鑑というシートにデータをペーストするというマクロ...続きを読む

Aベストアンサー

プログラム自体の動きは全くチェックしていません。
色々おかしいところがありますが 自分でデバッグくらいできるように
ならないとダメだと思います。

42行目と 50行目の「End If」はどこに掛かっていますか?
51行目の Next sh2はどこに掛かっていますか?
最後の方の「dogagon」てつづりは合ってますか?
61行目の「End If」と 62行目の「End Select」の順番は合ってますか?
67行目の「End If」はどこと以下同文

初心者レベルでいいので VBAについての勉強を先にすべきだと思います。

QExcel関数 詳しい方教えてください

例えば
sheet1のA1に#0010入力するとD1に"可"か"不可"でるようにしたいです。A列に何も入力されていない場合は、D列に表示しないようにしたいです。
どの様にすれば良いのか分からないでので教えて下さい。

sheet2にデータ参照とします。
B列とC列に#を含む4桁の数字が入力しています。B列に含まれる#4桁の数字が"可"C列に含まれる#4桁の数字が"不可"をsheet1のD列に"可"か"不可"でるようにしたいです。A列に何も入力されていない場合は、D列に表示しないようにしたいです。(B列とC列は同じ数字は存在しません。)
画像添付は、sheet2参照となります。
教えてくださいお願いいたします。

Aベストアンサー

こんにちは、No.1の方が回答してくださったものに、Aが空欄だったら空欄 とIF式を追加してみてはいかがでしょうか。

=IF(A1="","",IF(COUNTIF(Sheet2!B:B,A1),"可",IF(COUNTIF(Sheet2!C:C,A1),"不可","")))

Q関数式の入った列で五十音順のソートをすることは可能ですか?

エクセル2010を使っております。
VlOOKUP関数をベースにした数式で市町村名を取得した列(D列です)があるのですが、その列で五十音順のソートをかけると所々、デタラメな順番になってしまいます。
取得する元の市町村名のデータにはフリガナが入っているのですが、ソートができない理由を確認するためにPHONETIC関数でD列のフリガナを取得しようとしたところ、何も値が取得できませんでした。

どのようにすれば、D列で五十音順のソートができるのか、ご教示願います。

Aベストアンサー

今、思いついたのですが、こんな方法でできます。
VLOOKUPの代わりに、INDEX関数を使えばよいのです。

例えば、
A1 に検索値があるものとし、Sheet2 に郵便番号から住所データがあるとします。

=PHONETIC(INDEX(Sheet2!$A$1:$F$300,MATCH(A1,Sheet2!$A$1:$A$300,0),5))

QExcelでシートのこうばんの一番下を表示させる方法が分かりません。関数でどう表示させるのでしょうか

Excelでシートのこうばんの一番下を表示させる方法が分かりません。関数でどう表示させるのでしょうか?行が更新しても表示させたいです。

Aベストアンサー

文章から察するに、データを追加していき、一番下のデータを取得したい。ということでしょうか?
途中に空白が無いという前提でしたら、COUNTAで列全体のデータの数を取得し、HLOOKUPなりINDIRECTなりでその行にあたるデータを取得すればよろしいかと思います。
もしくはID(番号でも日付でもいいので、昇順で重複しないもの)の列を作り、MATCHとMAXを用いて、その列の最大値に一致するデータのある位置を取得する。というのでもよろしいかと。(IDが行番号と一致するならMATCH使わずにMAXだけで可)

これらの方法でできないようであれば、もっと具体的な説明をお願いします。
(こうばんの一番下というのが、何を表示させたいといっているのかきちんと分かるように)

Q複数シートを集計したい(別シートへ集計結果を表示させたい)

シートごとに月別の取引先別商品別の計画と実績が入っています。
(※シートフォーマット参照)
この表に関してはすでに数式を組んでいるのですが、この取引先別の複数シートのデータを
一つに集計する別シートを作成したいです。(※合計フォーマット参照)
※取引先CDは7桁、商品CDは12桁

それぞれのシートの下のほうに数量、売上、仕入、粗利益(売上@、仕入@は数量で割る)の合計欄を設けているのでその数字を集計した別シートへ表示させたいです。

取引先別のシートのフォーマットは同じですが、取引先ごとに商品数が違う為、合計欄の行数が異なります。
複雑すぎて、関数でやったら良いのかマクロでやったら良いのか?
また、それぞれの場合どういった関数を組めばorマクロを組めばご教授願います。

Aベストアンサー

No4です。
No7は無視してください。
エラーが発生する原因は、セルの内容に数値でないものが設定されていることと考えられます。
数値でないセルを検出時、合計シートのそのセルのアドレス(行列)と内容をエラー表示するようにしました。
エラーメッセージが表示されたセルの内容をご確認ください。
又、データの作成されていない月については、データの加算をしないようにしました。
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
下記URLに修正版を登録しました。

http://climbi.com/b/9943/2

実際に変えたのは、
'エリア合計
Private Sub AreaGoukei(ByVal title As String, ByVal gs As Worksheet, ByVal rowstart As Long, ByRef rowg As Long)

'東・西日本合計
Private Sub AllGoukei(ByVal title As String, ByVal gs As Worksheet, ByVal rowE As Long, ByVal rowW As Long, ByRef rowg As Long)
の2つのプロシージャです。(これ以外は変えていませんで、この2プロシージャのみ置き換えても構いません)
これで、再確認してください。

No4です。
No7は無視してください。
エラーが発生する原因は、セルの内容に数値でないものが設定されていることと考えられます。
数値でないセルを検出時、合計シートのそのセルのアドレス(行列)と内容をエラー表示するようにしました。
エラーメッセージが表示されたセルの内容をご確認ください。
又、データの作成されていない月については、データの加算をしないようにしました。
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
下記URLに修正版を登録しました。

http://climbi.com/b/9943/2

実際に変...続きを読む

Q「見出し」が「行列番号」とな?!

ご存じない方のために、と、私の備忘録のために記しておきます。

Excel 2013 の設定で発見!
シート見出しを非表示にするつもりで、[表示]→[表示 <見出し>]に付いているチェックを外してビックリポン!消えたのは何と"行列番号"なのです。
単に「見出し」とくれば、
[シート見出しを表示する](Show sheet tabs)の「見出し」と思ってしまう!
片や[行列番号を表示する](Show row and column headers)には日本語「見出し」は見当たらず!
[表示]→[表示 <見出し>]の「見出し」部分は、気を利かして「行列番号」にして欲しかったなぁ~!
英語版の「Headers」を単に直訳してたなんて、お粗末!

態々[ファイル]→[オプション]に行かずとも、ワークシートを表示させたままで、「シート見出し」を一時的に非表示にする方法を教えてください。

この機会に、他の翻訳上の不具合をご存知の方、教えてください。

Aベストアンサー

こんばんは。

>他の翻訳上の不具合をご存知の方、教えてください。

誰もレスをつけないところをみると、そんなに重視していないかもしれません。

初めて、「ポップヒント」"Pop Hint" という言葉を聞いた時に、lollipop の一種かと思いました。英語では、そんな言い方しないですね。Pop も Hint も英語では意味が違います。Pop は、Popular ですし、Hint ≒ Alluding
ふつうは、Screen Tips と言うかと思います。

そもそも、Row と Column が、行と列っていうのも変ですが。

Screeen Tips は、機能名ですが、タブなどの名称のことを、idMso と呼び、リボンカスタマイズの時には重要に役割を果たします。

・「シート見出し」を一時的に非表示にする方法を教えてください。

探してみましたが、シート見出しのオンオフのコントロールが見つかりません。(もしかしたら探し方が悪いのかもしれません)とりあえず、マクロということになってしまいます。

QAT(クイックアクション・ツールバー)では、ボタンしかつけられません。タブのグループの中では、チェックボックスも貼り付けることが可能です。

リボンカスタマイズします。

<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" >
<ribbon startFromScratch="false">
<tabs >
<tab idMso="TabHome">
<group id="Group1">
<checkBox id="DisplayWorksheetTabs" label="シート見出し" onAction="dispTabs"/>
</group>
</tab>
</tabs>
</ribbon >
</customUI >

本格的には、
C:\Users\[Your ID]\AppData\Local\Microsoft\Office\
Excel.officeUI
このファイルを書き換えてあげます。たぶん、VSTOで書き換えたほうが良いのだと思います。画像は、上記のコードを簡易的にCustomUIとしてファイルに入れた結果です。

こんばんは。

>他の翻訳上の不具合をご存知の方、教えてください。

誰もレスをつけないところをみると、そんなに重視していないかもしれません。

初めて、「ポップヒント」"Pop Hint" という言葉を聞いた時に、lollipop の一種かと思いました。英語では、そんな言い方しないですね。Pop も Hint も英語では意味が違います。Pop は、Popular ですし、Hint ≒ Alluding
ふつうは、Screen Tips と言うかと思います。

そもそも、Row と Column が、行と列っていうのも変ですが。

Screeen Tips は、機能名ですが...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング