Excel2007マクロで台帳シートの値を人件費シートに追加する方法

前へ 次へ
このQ&Aのポイント
  • Excel2007のマクロを使用して、台帳シートのセルをダブルクリックすると、人件費シートの一番新しい列に台帳シートの値が追加されます。
  • 同様に、G列でも外注費シートに台帳シートの値が追加されます。
  • H列を追加し、材料費シートに台帳シートの値を追加したいと考えていますが、方法がわかりません。
回答を見る
  • ベストアンサー

Excel2007　マクロについて

自分で何とかしようと思い試行錯誤しましたがダメでしたのでご指導のほどお願いします。 今のコードが下記です Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Application.Intersect(Target, Range("F:G")) Is Nothing Then Exit Sub Application.Goto Worksheets(IIf(Target.Column = 6, "人件費", "外注費")).Range("A65536").End(xlUp).Offset(1) ActiveCell.Value = Cells(Target.Row, "A").Value cancel = True End Sub 台帳シートのF列のセルをダブルクリックするとその列の先頭A列の数字を持って人件費シートが開き　一番新しい列のA列に台帳シートの値を入れる というコードです G列では外注費で同じ事が行われます。 それにH列を追加し材料費シートをに同じ事を行いたいのですがわかりません ご指導のほどお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • mt2008
  • ベストアンサー率52% (885/1701)
回答No.1

IIFは条件が成り立つ時と不成立の時の2パターンだけですから、他の手段を使いましょう。 以下の例ではSelect Caseを使ってみました。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) 　　If Application.Intersect(Target, Range("F:H")) Is Nothing Then Exit Sub 　　Select Case Target.Column 　　　　Case 6 　　　　　　sSheetname = "人件費" 　　　　Case 7 　　　　　　sSheetname = "外注費"　　　　　　 　　　　Case Else 　　　　　　sSheetname = "材料費" 　　End Select 　　Application.Goto Worksheets(sSheetname).Range("A65536").End(xlUp).Offset(1) 　　ActiveCell.Value = Cells(Target.Row, "A").Value 　　cancel = True End Sub

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. Excel（エクセル）

関連するQ&A

  • Excel　VBAについて

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub Application.Goto Worksheets("人件費").Range("A1") Worksheets("人件費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub Application.Goto Worksheets("外注費").Range("A1") Worksheets("外注費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub 上の指令はFの列をダブルクリックすると人件費のシートが開いてAある値を人件費の新しいセルのAに代入する指令ですが それをG列ダブルクリックで外注費シートに同じようにやろうと思いましたが出来ません。 たぶん根本的に書き方が間違っているのかと思われますが、ご指導のほどお願いします。

  • Excel2007　マクロについて

    たとえばですが sheet1のF5列をダブルクリックすると、その左側にあるA5の値をコピーし sheet2のA列の未入力行へ貼り付けするにはどうしたらよいでしょうか Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub cancel = True End Sub とりあえずここまで作って開くことは開いたのですが、その先がわからず困っております。 よろしくお願いいたします。

  • マクロで二つの構文を繋ぐには

    いつもお世話になります。 WIN7 EXCELL2010　です。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value End Sub ThisWorkbook　に上記のマクロに下記のマクロを追加したいのですが、 End Sub の　ところを　End If　End With などに変えたのですがうまくゆきません。 御指導お願いできませんでしょうか。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim myRange As Range Set myRange = Intersect(Target, Range("M3:V27")) If Not myRange Is Nothing Then Select Case Target.Value Case "" Target.Value = "○" Case "○" Target.Value = "●" Case Else Target.ClearContents End Select Cancel = True End If End Sub 宜しくお願いいします。

  • このマクロあっていますでしょうか？よろしくお願いいたします。

    ★sheetＡ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$C$14" And Target.Address <> "$C$19" _ And Target.Address <> "$F$19" Then Exit Sub If Target.Address <> "$R$14" And Target.Address <> "$S$14" _ And Target.Address <> "$T$19" Then Exit Sub Application.EnableEvents = False With Sheets("Ｂ") .Range("F14").Value = Range("C14").Value .Range("F17").Value = Range("C19").Value .Range("F20").Value = Range("F14").Value .Range("F23").Value = Range("F19").Value End With With Sheets("Ｃ") .Range("F13").Value = Range("R14").Value .Range("F14").Value = Range("S14").Value .Range("F18").Value = Range("T19").Value End With Application.EnableEvents = True End Sub ★sheetＢ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$F$14" And Target.Address <> "$F$17" _ And Target.Address <> "$F$23" Then Exit Sub Application.EnableEvents = False With Sheets("Ａ") .Range("C14").Value = Range("F14").Value .Range("C19").Value = Range("F17").Value .Range("F19").Value = Range("F23").Value End With Application.EnableEvents = True End Sub ★sheetＣ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$F$13" And Target.Address <> "$F$14" _ And Target.Address <> "$F$18" Then Exit Sub Application.EnableEvents = False With Sheets("Ａ") .Range("R14").Value = Range("F13").Value .Range("S14").Value = Range("F14").Value .Range("T19").Value = Range("F18").Value End With Application.EnableEvents = True End Sub

  • ２つのマクロの組合せがうまくいきません

    Excel2002を使用しています。 ・シートに変更があった場合、可否を問うメッセージを出す。 ・但し、「A1」及び「D、E列」の変更は除外する。 ・「D、E列」をダブルクリックしたら、アクティブセルに「済」の文字が入る。 という事をしたくて、Sheet1に以下のようなコードを書きましたが、うまくいきません。 「A1」の変更は除外されるのですが、DE列への変更はメッセージが出てしまいます。 又、そのメッセージが出た際「いいえ」を選択するとエラーになります（Application.Undo）。 Private Sub Worksheet_Change(ByVal Target As Range) Dim 変更回答 As Integer If Target.Address = "$A$1" Then Exit Sub If Target.Columns = ("4:5") Then Exit Sub 変更回答 = MsgBox("セル：" & Target.Address(False, False) & "が変更されました。" & vbCrLf & _ "　　　「はい」　… 変更許可" & vbCrLf & "　　　「いいえ」… 内容破棄", vbYesNo) Application.EnableEvents = False If 変更回答 = vbYes Then Application.EnableEvents = True Exit Sub Else Application.Undo End If Application.EnableEvents = True End Sub 　　　＊＊＊＊＊＊ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 4 Then ActiveCell = "済" Cancel = True End If If Target.Column = 5 Then ActiveCell = "済" Cancel = True End If End Sub 以上、ご教授、宜しくお願い致します。

  • Excel2003 マクロをご教授ください！

    いつもお世話になっております。 ここで 様々な方にご教授いただいて Excelのマクロを反映させられたのですが マクロを貼り付けた後で列を削除したり、各種編集をしていたら 今まで動作していたマクロが動作しなくなってしまいました。 以下 前文を記しますが 動作しないのは 下のマクロです。 Private Sub Worksheet_Change(ByVal Target As Range) Dim rOne As Range Dim intNo As Integer If Target.Column <> "15" Then Exit Sub For Each rOne In Target intNo = Val(StrConv(rOne.Value, vbNarrow)) Select Case (intNo) Case 1 Range("p" & rOne.Row).Select Case 2 Range("x" & rOne.Row).Select Case 3 Range("z" & rOne.Row).Select Case Else End Select Next rOne If Intersect(Target, Range("L3:L3001")) Is Nothing Then Exit Sub If Target.Count > 1 Then Exit Sub Application.ScreenUpdating = False Application.EnableEvents = False With Target.Offset(0, 1).Validation .Delete .Add Type:=xlValidateInputOnly .IMEMode = xlIMEModeHiragana End With If Target Like "###-####" Then Target.Offset(0, 1).Select SendKeys Target.Value SendKeys "{ }" SendKeys "{ENTER}" End If Application.EnableEvents = True Application.ScreenUpdating = True End Sub 上のマクロ（セルを飛ばす）は正常に動作してくれるのですが 下のマクロで郵便番号を自動的に隣のセル（Ｍ列）に反映してくれなくなってしまいました。 Ｍ列のとなり（たしかＮ列だったと思うのですが）を削除したあたりから この郵便番号マクロが動作しなくなってしまいました。 どこか おかしな所はないか見ていただけますでしょうか。 宜しくお願い致します。

  • ダブルクリックで自動入力

    初心者です。教えて下さい。 一つのBOOKに二つのSheetがあります。 Sheet”データ”のA列に番号が入力してあり、そのセルをダブルクリックすると Sheet”印刷”の（A18）にダブルクリックした番号が入力され、 2回目からは前に入力したセルの一つ下に入力されるようにしたいのですが・・ 下記を自分で作ってみましたが、何度やっても（A18）にしか自動入力されません。 どのようにしたら最終行の下に入力されるようになるのでしょうか？ 色々調べてみましたが分かりませんでした・・・宜しくお願い致します。 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If Target.Count > 1 Then Exit Sub If Target.Column <> 1 Then Exit Sub Cancel = True With Worksheets("印刷") MyRange = Range("A18").End(xlUp).Offset(1).Address .Range(MyRange).Value = Target.Value Application.Goto .Range(MyRange) End With End Sub

  • 【Excel】 マクロを補足してください。

    A1をダブルクリックすると E、D、C、B列のオートフィルタで「すべて」を 選択するようにしました。 続けて 同じシートで、B1をダブルクリックするとE、D、C列の オートフィルタで「すべて」を選択、 C1をダブルクリックするとE、D列のオートフィルタで 「すべて」を選択するようにしたいのですが、 どのようにしたらよいのでしょうか。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address <> "$A$1" Then Exit Sub Cancel = True Selection.AutoFilter Field:=5 Selection.AutoFilter Field:=4 Selection.AutoFilter Field:=3 Selection.AutoFilter Field:=2 End Sub お願いいたします。

  • このマクロの説明をお願いします

    Dim buf As String Private Sub CommandButton1_Click() End Sub Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim tmp As Variant Application.EnableEvents = False tmp = InStr(2, buf, "$", vbTextCompare) tmp = Right(buf, Len(buf) - tmp) If buf = "$B$" & tmp Then Range("C" & tmp).Value = Range("C" & tmp).Value + Range("B" & tmp).Value Range(buf).Select End If Application.EnableEvents = True End Sub Private Sub Worksheet_SelectionChange(ByVal Target As　Excel.Range) buf = ActiveCell.Address End Sub どうやらB列の各セルに入力がされた場合、隣接するC列のセルに加算していくマクロのようです。 なんですが、 InStr関数、Right関数、Len関数あたりでやっていることがよくわかりません。 Private Sub CommandButton1_Click()は必要なのでしょうか？ あと、 もっとシンプルなマクロができるようでしたらご教授ねがいます。

  • 【ExcelVBA】 既にあるマクロの間で実行させたいのです。

    こんにちは 下のマクロを・・・ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Const RangeName As String = "●入力" If Not Intersect(Range(RangeName), Target) Is Nothing Then Cancel = True If Target = "●" Then Target = "" Else Target = "●" End If End If End Sub このマクロの■ここで実行■で実行させたいのですが、どのようにしたらよいでしょう。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address <> "$D$1" Then Exit Sub Cancel = True Columns("A:U").Select Range("T1").Activate Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin, DataOption1:=xlSortNormal Selection.Replace What:="ああ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("D1").Select End Sub ■ここで実行■ Private Sub Worksheet_Change(ByVal Target As Range) strAddress = "A1:A2000" On Error GoTo ErrorHandler If Target.Count > 1 Then GoTo ErrorHandler If Not Intersect(Target, Range(strAddress)) Is Nothing Then Application.EnableEvents = False Range(strAddress).ClearContents Target.Value = "●" End If ErrorHandler: Application.EnableEvents = True End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する