• ベストアンサー
  • 困ってます

VBAで修正ボタンを作成

先ほどは登録ボタンを作成したのでが、 修正ボタンもあれば便利だと思い作りたいのですが 一向にできません。 一覧表より、番号を検索して一致するセルの場所に 上書き?保存をするようにしたいのですが どのようにすればよいでしょうか? 先ほどから新たに訂正を加えたのですが、 やはりダメでした。 Private Sub CommandButton2_Click() '修正ボタン Dim bk As Workbook Dim sh1 As Worksheet Dim sh2 As Worksheet Dim cnt1 As Long Set bk = ThisWorkbook Set sh1 = bk.Worksheets("現場登録検索") Set sh2 = bk.Worksheets("一覧") cnt1 = 6 'マッチ Range("F2").Select n = ActiveCell.FormulaR1C1 = "=MATCH(RC[-1],一覧!C[-5],0)" cnt1 = n '送り方 sh2.Cells(n, 22).Value = sh1.Cells(4, 3).Value '封筒 sh2.Cells(n, 23).Value = sh1.Cells(5, 3).Value MsgBox "修正できました。" End Sub よろしくお願い致します。

共感・応援の気持ちを伝えよう!

  • 回答数5
  • 閲覧数138
  • ありがとう数2

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

  • ベストアンサー
  • 回答No.5

NO.4間違えました。ごめんなさい。 n = ActiveCell.FormulaR1C1 = "=MATCH(RC[-1],一覧!C[-5],0)" のところを ActiveCell.FormulaR1C1 = "=MATCH(RC[-1],一覧!C[-5],0)" n = ActiveCell.Value にしてみるとどうでしょうか? ActiveCellがだめな場合はRange("F2")とか、 Cells(2,6)(F2のセル位置)にしてみたりしてください。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ありがとうございました!!とっても感動です!! すごいです。\(^o^)/ これで楽になります。 ほんとうに感謝です。 <m(__)m>

関連するQ&A

  • エクセルVBAで

    登録ボタンを作りたいのですが うまくいきません。 応答無しになってしまいます。 仕事でコードを入力して、住所やその他の関連事項を 登録して、検索し、封筒に宛名印刷し、登録内容の修正をしたいと思っています。 登録ボタンは下記のようなものを作りました。 Private Sub CommandButton1_Click() Dim bk As Workbook Dim sh1 As Worksheet Dim sh2 As Worksheet Dim cnt1 As Long Set bk = ThisWorkbook Set sh1 = bk.Worksheets("現場登録検索") Set sh2 = bk.Worksheets("一覧") cnt1 = 6 Do While sh2.Cells(cnt1, 2).Value <> "" cnt = cnt1 + 1 Loop '得意先CD sh2.Cells(cnt1, 2).Value = sh1.Cells(2, 3).Value '現場CD sh2.Cells(cnt1, 3).Value = sh1.Cells(3, 3).Value '送り方 sh2.Cells(cnt1, 22).Value = sh1.Cells(4, 3).Value '封筒 sh2.Cells(cnt1, 23).Value = sh1.Cells(5, 3).Value MsgBox "登録できました。" End Sub 何が悪いのでしょうか? よろしくお願い致します。

  • どなたかマクロ修正お願いします。

    自分なりに 作成してみましたがどうもうまくいきません。 Sub 変換() Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet, Dim r As Range Set Sh1 = Worksheets("1") Set Sh2 = Worksheets("2") Set Sh3 = Worksheets("3") Sh3.Select Set c = Cells.Find(What:="9876543", LookAt:=xlWhole) c.Offset(, 1).Activate ActiveCell.Replace What:="中田", Replacement:="中田英寿" End Sub このように作成しましたがうまくいきません。恐らくsheet3のデータはsheet1から( =1!A100 )といったように値を他のsheetから持ってきてるからではないんでしょうか?

  • VBA 初心者

    sheet1から、sheet2データを検索して抽出する練習をしているのですがerror"1104"が表示されます、なぜなのか分からないので投稿しました、よろしくお願いします。 sub test() dim sh1 as worksheets dim sh2 as worksheets dim  i  as  integer set sh1 = thisworkbook.worksheets("sheet1!") set sh2 = thisworkbook.worksheets("sheet2!") b = userform1.textbox1 for i = 1 to 10 sh1 .cells(i,2) = b b = b+1 x = sh1.cells(1,2) sh1.cells(i,3).value = worksheetfunction.vlookup(x,sh2.range("a1:d500"),2,false) next i end sub

その他の回答 (4)

  • 回答No.4

セルの関数の結果が取得できていないようですね。 n = ActiveCell.FormulaR1C1 = "=MATCH(RC[-1],一覧!C[-5],0)" cnt1 = n のところを ActiveCell.FormulaR1C1 = "=MATCH(RC[-1],一覧!C[-5],0)" cnt1 = ActiveCell.Value にしてみるとどうでしょうか?

共感・感謝の気持ちを伝えよう!

  • 回答No.3

簡単な処理の概要としては、 一度、現場登録検索のシートのF2セルに =MATCH(RC[-1],一覧!C[-5],0) の結果を表示し、 その結果によってセルに値を入れる ということでよいでしょうか。 この場合、F2セルに正しい値が出ているでしょうか? 自分の期待した数値?が出ていなければ、 1.関数が実行できていない(セルの書式設定が文字列など) 2.関数の結果が出ていない(値が出ない、関数が間違っている) 3.セルの指定が間違っている(rangeの指定法が違う、シートが違う) などのことが考えられますし、 逆に、値が正しければ、 最後に値を設定するところがおかしい ということになりますよね。 うまくいっていない場所のあたりをつけるところからやってみてはどうでしょうか。

共感・感謝の気持ちを伝えよう!

質問者からの補足

'マッチ関数で探す Range("F2").Select ActiveCell.FormulaR1C1 = "=MATCH(RC[-1],一覧!R[-1]C[-5]:R[1998]C[-5],0)" ↑ =MATCH(E2,一覧!A1:A2000,0)の意味です。 関数はうまく動いているように思います。 値もしっかりでています。 '得意先CD sh2.Cells(n, 2).Value = sh1.Cells(2, 3).Value          ↑        ここの部分がおかしい。           '現場CD sh2.Cells(n, 3).Value = sh1.Cells(3, 3).Value MsgBox "修正できました。" End Sub 結局、シート一覧は 検索CD得意先CD現場CD得意先名検索1よみがな現場名検索2よみがな郵便番号住所1住所2TELFAX宛名1宛名2郵便番号住所1住所2TELFAX送り方封筒営業担当営業担当締め日NK請求伝票類継続指定Excel表紙注意書き終了日5月6月7月8月9月10月11月12月1月2月3月4月5月6月7月8月9月10月11月12月 A5~BB5まで横にずらずらと上記の項目があり 入力しずらいので、シート2に現場登録などという 縦に項目を並べて1シート内でバーを動かさないで すむようにしたいのです。 現場のコードが2000件ぐらいになります。 日々変更と更新があるので困っています。 アクセスがいいのはわかっていますが 会社にはありません。 又、登録ボタンと検索ボタンはできたので 検索で表示させた内容から、修正して 一覧に(入力)登録できればとっても便利なので がんばってなんとかしたいのです。 助けて下さい。

  • 回答No.2

実行する際に、VBEの画面から「デバック」「ステップイン」で実行してみて、cnt1 = nの部分でnにカーソルをあてて、nの値を確認してみてください。nには値が設定されているでしょうか? nに値が設定されていれば、代入はされるはずです。

共感・感謝の気持ちを伝えよう!

質問者からの補足

"ステップイン"やってみました。 : n : エラー 2042 : Variant/Error でした。(>_<) だめと言うことですね。 nをはずすと、関数としてF2にしっかりと値は入るのですが・・・。 代入のが変なのでしょうか?

  • 回答No.1

初めて見るのでちょっとよくわかりませんが、 Range("F2").Select のところが少し違和感があります。 どのシートなのか? 範囲指定の方法はこれであっているか? 的外れだったらすみません。

共感・感謝の気持ちを伝えよう!

質問者からの補足

説明が悪くてすみません。 Range("F2").Select は現場登録検索のシートです。 とりあえず、=MATCH(E2,一覧!A:A,0) で一覧のどのセル番地か調べて、nに代入すると言うのを考えたのですが、 sh2.Cells(n, 22).Value = sh1.Cells(4, 3).Value 上記がデバックになります。 どうしたらいいのでしょうか?

関連するQ&A

  • VBA なんですが

    VBA なんですが すべてのワークシートを順番に選択して 指定した範囲をコピーし『まとめ』と言う別のシートに貼り付けたいのですが どうしたらいいのかわかりません。 それらしいのは考えたのですが Set sh = Worksheets(sh.Name)でエラーになります。 頭がいいかた教えてください。   Dim sh3 As Worksheet Dim sh As Worksheet Dim en As Long Set sh3 = Worksheets("まとめ") For Each sh In ActiveWorkbook.Worksheets If sh.Name <> "まとめ" Then en = sh.UsedRange.Rows.Count Set sh = Worksheets(sh.Name) sh.Range(Cells(2, 1), Cells(en, 10)).Copy

  • エクセルVBAで実行時エラー 91 が出ます

    エクセル2000です 各部署の棚卸を纏める為のVBAを作成しているのですが、実行時にエラーになってしまいます エラーメッセージは 「実行時エラー 91   オブジェクト変数またはWithブロック変数が設定されていません」 です ご教授お願いいたします Sub 棚卸() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("在庫集計票") Set sh2 = Worksheets("棚卸表") x = sh2.Range("A65536").End(xlUp).Row Z = sh1.Range("d2").Value ’部署番号 sh1.Range(Cells(5, Z), Cells(3000, Z)).ClearContents For i = 2 To x y = sh1.Range("A2:A" & Range("A2").End(xlDown).Row). _ Find(sh2.Cells(i, "a")).Row ’ここでエラーが発生します sh1.Cells(y, Z) = sh2.Cells(i, "c") Next i End Sub

  • マクロ 一覧からシートを作成する

    いつも回答して頂き、とても感謝しています。 似た様な質問を過去にしていますが、 前回の質問は、一列にシート名が記載しており、これを参照してシートを次々と挿入するマクロの作り方でしたが、今回は、複数列にシート名が記載されている場合のマクロ記述についてです。 自分なりに考えてみましたが、set = s の値がNOTHINGになり、挿入したシートに名前を記載する事ができませんでした。原因がさっぱり分からないので御教授の程宜しくお願い致します。 Sub シートの挿入() Dim s As Worksheet Dim r As Long Dim c As Long On Error GoTo errhandle c = 2 With Worksheets("作業名一覧") For r = 2 To .Cells(Rows.Count, c).End(xlUp).Row Do While .Cells(r, c).Value <> "" Set s = Worksheets(Cells(r, c).Value) c = c + 1 Loop Next r End With Exit Sub errhandle: Worksheets.Add after:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = Cells(r, c).Value Worksheets(h.Value).Cells.ColumnWidth = 1 Worksheets(h.Value).Cells.RowHeight = 15 Resume End Sub

  • VBAで散布図を作成したのですが・・・

    VBAで散布図を作成したいのですがうまくいかないで困っています。 この散布図はA行とB行をそれぞれ軸として指定しているのですがうまくX軸、Y軸に指定されず2本のグラフが表示されてしまいます。 また範囲指定をC1を変数としてA1からB○まで取りたいのですが最初の範囲指定はうまくいったのですが最後の行の指定がうまくいかずエラーになってしまいます。 (○は"C1の値+4"にしたいのです。) よろしければ何かヒントでもいいので教えていただけないでしょうか?よろしくお願いします。 (私が書いたVBA↓) Sub chart1() Dim sh1 As Worksheet Set sh1 = Worksheets("Sheet1") Dim i As Integer i = Range("C1").Value + 4 Range(Cells(1, 1), Cells(i, 2)).Select Charts.Add ActiveChart.ChartType = xlXYScatterSmooth ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range(Cells(1, 1), Cells(i, 2))

  • VBAで教えてください。

    下のようなコードを見つけて勉強しています。 簡単な応用ができません・・・。 P1=今日の日付 G=訪問日 I=御礼の手紙を書いた日付 として、 訪問日が過ぎていて、御礼の手紙が未入力なら“超過があります”とメッセージと色で知らせるものですが、 下のような感じで P1=今日の日付 I=御礼の手紙を書いた日付 K=返事が来た日付 御礼の手紙を書いた日付から20日が過ぎてもK列に返事が来た 日付が入力がないものには ・“返事がありません”とメッセージ ・薄い灰色に行を塗る というようにしたいのですが、教えていただけないでしょうか。 自分では、+20という表現をどのように書いたらいいのかというとこ ろで躓いてしまいました。 どうぞ宜しくお願いします。 Sub test () Dim SH As Worksheet Dim i As Integer Dim s As String Set SH = Worksheets("表") s = "超過はありません。" i = 1 Do Until SH.Cells(i + 3, "A").Value = "" If SH.Cells(i + 3, "G").Value < SH.Range("P1") And _ SH.Cells(i + 3, "I").Value = "" Then SH.Cells(i + 3, "A").Resize(, 16).Interior.ColorIndex = 3 s = "超過があります。" End If i = i + 1 Loop MsgBox s End Sub

  • VBAで統計プログラムを作成しています。

    現在VBA(Excel)にて統計のプログラムを作成しています。 Sheet2に統計表 統計対象のシートはシートタブの色が赤色(枚数不特定) 統計表の縦軸には、B4&#65374;15に4&#65374;3(1年度の月)。横軸にはF&#65374;J4に1&#65374;5。 統計対象シートの構成は同じで セルE4に1&#65374;5の数字のどれか セルE24には1&#65374;12の数字のどれかが入ります 統計表イメージ A    B    C    D 1    1    2    3 2 4月 3 5月 4 6月 5 7月 入力画面(シート名部分赤シート) E4 ←1&#65374;5のどれか E24 ←1&#65374;12のどれか この場合において、たとえばE4が"1"、E24が"4"だった場合 統計表のB2にカウントされるというプログラムが作りたいのですが、 Option Explicit Private Sub CommandButton2_Click() Dim Ws As Worksheet Dim cnt As Variant Dim grade() As Variant 'grade = grd = 学年 grade = Array("1", "2", "3", "4", "5") Dim month() As Variant 'month = mnt = 月 month = Array("4", "5", "6", "7", "8", "9", "10", "11", "12", "1", "2", "3") Dim grd As Integer '各変数宣言 Dim mnt As Integer Dim set1 As Integer Dim set2 As Integer Dim 月ー所 As Worksheet For grd = 1 To 5 If Cells(4, 5).Value = grade(grd - 1) Then cnt = 0 set1 = grd + 5 End If For mnt = 1 To 12 If Cells(24, 5).Value = month(mnt - 1) Then set2 = mnt + 3 End If   For Each Ws In Worksheets If Ws.Tab.ColorIndex = red Then cnt = cnt + 1 End If Next Worksheets("月ー所").Cells(set2, set1).Value = cnt ←この行でエラー1004 Next mnt Next grd MsgBox "統計しました。" End Sub 矢印で示した行のエラー1004の解除方法が分からず悩んでいます どうかよろしくお願いいたします。

  • 【VBA】別々のシートに列ごとコピーしていきたい

    エクセルVBA初心者です 以下のような表を、地区別にわけられたシートで、種別を選んで貼り付けていきたいのですが 地区 種別 1 大阪 金 2 東京 銀 3 名古屋 銀 4 大阪 金 5 大阪 銅 6 名古屋 銅 7 東京 金 8 名古屋 金 9 大阪 銅 金と銀のみ、地区に分けられたシートに貼り付け シート【大阪】 1 大阪 金 4 大阪 金 シート【東京】 2 東京 銀 7 東京 金 シート【名古屋】 3 名古屋 銀 8 名古屋 金 以下のVBAを加工してみましたが組んでみましたがうまくいきません どうかご教示のほどよろしくお願いします ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ Public Sub cptest() Dim sht1 As Worksheet Dim sht2 As Worksheet Dim rng As Range Dim cel As Range Dim stcrng As New Collection Dim lastRow As Integer Dim cnt As Integer Set sht1 = ThisWorkbook.Worksheets("Sheet1") Set sht2 = ThisWorkbook.Worksheets("Sheet2") lastRow = Range("G65535").End(xlUp).Row Set rng = sht1.Range("G1:G" & lastRow) For Each cel In rng If cel.Value = "あり" Then Set cel = sht1.Range(cel.Offset(0, -4), cel.Offset(0, -1)) stcrng.Add cel End If Next sht2.Cells.Clear cnt = 0 Set rng = sht2.Range("A1") For Each cel In stcrng cel.Copy rng.Offset(cnt, 0).PasteSpecial rng.Offset(cnt, 4).Value = "_" cnt = cnt + 1 Next Application.CutCopyMode = False End Sub

  • ExcelVBAテキストでの疑問

    Option Explicit Sub 請求書作成(Kokyaku As String) '引数「Kokyaku」は請求書を作成する顧客名 ここだけなぜ「請求書作成」、引数を宣言するのかが不明です。    Dim i As Integer '「販売」ワークシートの表の処理用カウンタ変数 Dim Cnt As Integer '請求書のワークシートの表の処理用変数 Cnt = 12 '請求書のワークシートの表の先頭行(12行目)の値に初期化 'ワークシート「請求書雛形」を末尾にコピー Worksheets("請求書雛形").Copy After:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = Kokyaku 'ワークシート名を設定 Worksheets(Kokyaku).Range("A6").Value = Kokyaku '請求書の宛先を設定 Worksheets(Kokyaku).Range("E2").Value = Date '請求書の発行日を設定 '指定した顧客の販売データを請求書へコピー For i = 4 To 32 If Worksheets("販売").Cells(i, 2).Value = Kokyaku Then Worksheets(Kokyaku).Cells(Cnt, 1).Value = Worksheets("販売").Cells(i, 1).Value '日付 Worksheets(Kokyaku).Cells(Cnt, 2).Value = Worksheets("販売").Cells(i, 3).Value '商品 Worksheets(Kokyaku).Cells(Cnt, 3).Value = Worksheets("販売").Cells(i, 4).Value '単価 Worksheets(Kokyaku).Cells(Cnt, 4).Value = Worksheets("販売").Cells(i, 5).Value '数量 Worksheets(Kokyaku).Cells(Cnt, 5).Value = Worksheets("販売").Cells(i, 6).Value '金額 Cnt = Cnt + 1 '請求書のワークシートの表のコピー先の行を1つ進める End If Next i End Sub Sub フォーム用意() myForm.Show End Sub

  • VBA PrintArea に引数を使いたい

    お世話になります 入力ファイルのある項目を抽出したデータを出力ファイルに同一フォーマットで出力しています。 この時印刷範囲の指定を行ってますが、経験値により概算で印刷されるであろう枚数を PrintAreaに指定していて、現状では抽出データの編集されたページ以降も何枚か印刷 の対象に入っているため、ムダな紙がプリントされてしまいます。 そこでディテイルカウントなる物を設け、改ページ毎カウントアップして印刷時に、プリントエリアを指定 するところで使いたいのですが、実行時エラー'1004'PrintArea が設定できませんのエラーが出て しまいます。 指定でよい方法があったらご教示願います。以下VBAの内容です。 Sub P_Print() ' Dim D_cnt As Integer Dim sh1 As Worksheet '添字 Dim sh2 As Worksheet 'd ; 入力データ、エクセルファイルの最終行番号 Dim d As Integer 'i ; 入力データ読込件数 Dim i As Integer 'j ; 出力側シートのラインカウンタ Dim j As Integer ' (5 -> 54行の間のループ) Dim K As Integer 'k ; 出力側シートのライン行 ' (実際に書き込む行) If 諸表印刷.記録A.Value = True Then Windows("記録(A).xls").Activate End If If 諸表印刷.記録B.Value = True Then Windows("記録(B).xls").Activate End If If 諸表印刷.記録C.Value = True Then Windows("記録(C).xls").Activate End If Sheets("原紙").Select Sheets("原紙").Copy Before:=Sheets(2) Sheets("原紙 (2)").Select Set sh2 = Worksheets("原紙 (2)") Windows("データ 2013年度").Activate Set sh1 = Worksheets(combo_sel) '諸表印刷フォームで選択されたシートをセット d = sh1.Range("A65536").End(xlUp).Row K = 5 j = 5 For i = 2 To d If sh1.Cells(i, "O") = P_sel Then    If j < 55 Then 'sh2.Cells(k, "A") = sh1.Cells(i, "A") 'sh2.Cells(k, "B") = sh1.Cells(i, "B") 'sh2.Cells(k, "C") = sh1.Cells(i, "C") 'sh2.Cells(k, "D") = sh1.Cells(i, "D") 'sh2.Cells(k, "E") = sh1.Cells(i, "E") 'sh2.Cells(k, "F") = sh1.Cells(i, "F") 'sh2.Cells(k, "G") = sh1.Cells(i, "G") K = K + 1 j = j + 1    Else '改ページ処理、Detail1行目の編集 K = K + 8 j = 5 'sh2.Cells(k, "A") = sh1.Cells(i, "A") 'sh2.Cells(k, "B") = sh1.Cells(i, "B") 'sh2.Cells(k, "C") = sh1.Cells(i, "C") 'sh2.Cells(k, "D") = sh1.Cells(i, "D") 'sh2.Cells(k, "E") = sh1.Cells(i, "E") 'sh2.Cells(k, "F") = sh1.Cells(i, "F") 'sh2.Cells(k, "G") = sh1.Cells(i, "G")     K = K + 1   j = j + 1   D_cnt = D_cnt + 1 ←ここでディテイルカウント +1 End If End If Next i If 諸表印刷.記録A.Value = True Then Windows("記録(A).xls").Activate ActiveSheet.PageSetup.PrintArea = "$A$1:$N$(D_cnt*58)" ←ここでエラーが出る End If If 諸表印刷.記録B.Value = True Then Windows("記録(B).xls").Activate ActiveSheet.PageSetup.PrintArea = "$A$1:$N$(D_cnt*58)" ←ここでエラーが出る End If If 諸表印刷.記録C.Value = True Then Windows("記録(C).xls").Activate ActiveSheet.PageSetup.PrintArea = "$A$1:$N$(D_cnt*58)" ←ここでエラーが出る End If End sub

  • EXCEL2010エラーVBA

    下記を実行するとエラーになりEXCEL2010が終了してしまいます。 fDebug:0 offset00009391 がエラーメッセージです。 何が原因でしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim rg As Range Dim r As Variant Dim c As Long Dim hanni1 As Range Dim atai As Range Set ws = Worksheets("あああ") Set rg = Worksheets("コード").Range("A1:B10") r = ws.Cells(Rows.Count, 1).End(xlUp).Row Set hanni1 = ws.Range(Cells(2, 2), Cells(r, 3)) Set atai = ws.Range(Cells(2, 3), Cells(r, 3)) atai = Application.VLookup(hanni1, rg, 2, False) End Sub