- 締切済み
シートの内容コピーマクロについて
エクセルシートに作成したシートのデーターを、別シートに自動で反映させてたいと思っております。 該当する文字を入力するだけでマクロを使用してその下にある数字を全てコピーできるようしたいと思っております。 添付シートを参照して頂ければと思いますが、シート1の元データーから、別シート2に文字を返して、その下にある文字が自動で反映できるような仕組みを構築したいと考えております。 添付は抜粋で元データーは400件以上あり、シート1の基本となる大元は、縦軸が800セル 横軸（時間軸）で、305セルまで使用しており、そこに順不同で品目と、下の数値が違うデータが入力させれております。 そこで、品目だけ入力すればその下の数字が自動で反映出来ればと思っております。 下記マクロですと、シート1の元データーがシート2へ全てが反映させれません。 何処を変更すればよろしいのでしょうか？ ----------------------------------------------------------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) 'この行から Dim cnt As Long, c As Range, r As Range, myRng As Range, wS As Worksheet Set wS = Worksheets("Sheet1") If Target.Count = 1 Then If Target <> "" Then Set c = wS.Cells.Find(what:=Target, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then Set myRng = c.CurrentRegion For Each r In myRng cnt = cnt + 1 If r = c Then Exit For Next r If Target.Column - cnt + 1 > 0 Then myRng.Copy Target.Offset(, -cnt + 1) Else MsgBox "左側列数が不足です。" Exit Sub End If Else MsgBox "該当データなし" With Target .Select .Value = "" End With Exit Sub End If End If End If End Sub 'この行まで ---------------------------------------------------------------------------------------------------- トラックの搬入時間管理の為、タイムリーな処理が必要な為、お詳しい方のお知恵をお借りできればと思いいます。 お忙しい所申し訳ありませんが、どなたかお力添えをよろしくお願いいたします。
- oba7030
- お礼率13% (3/22)
- Visual Basic
- 回答数7
- ありがとう数0
- みんなの回答 （7）
- 専門家の回答
関連するQ&A
- EXCELでSheetにデータを蓄積したい
Sheet1に入力シートを作成し、Sheet2に蓄積シートを作成しました。 Sheet1で作成されたデータをSheet2に蓄積させておきたい。 Sheet1のA2の値が入力された場合に実行するとすると Sheet1のデータ数は、毎回異なります。 他を参考に以下のように作ってみたのですが、 Private Sub Worksheet_Change(ByVal Target As Range) Dim lastA As Long, lastB As Long, ws1 As Worksheet, ws2 As Worksheet Set ws1 = Sheets("入力シート") Set ws2 = Sheets("蓄積シート") With Target If .Address <> "$A$2" Or .Count <> 1 Or IsEmpty(Target) Then Exit Sub If WorksheetFunction.Count(ws1.Range("a1:s1")) <> 19 Then Exit Sub lastA = ws2.Range("a65536").End(xlUp).Row lastB = ws1.Range(("a2:s2"), Selection.End(xlDown)).Select ws2.Range("a" & lastA + 1).Resize(1, 19).Value = _ ws1.Range("a2:S2").Resize(1, 19).Value End With End Sub 'ws1.Range("a2:S2").Resize(1, 19).Value の部分で '上記ws1の範囲の内、Row2の値しかws2へ反映されません どなたか教えて頂けないでしょうか。
- ベストアンサー
- オフィス系ソフト
- エクセル ＶＢＡ セルの色をSheet1とSheet2の両方を変えたいのですが・・・
最近困っているところが表題の通りなのですが Sheet1のＢ２を右クリックするとＢ２のセルの色を変えて Sheet2のＢ２のセルも色を変えたいというものです。 現状で Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Dim Rng As Range, myRng As Range Dim RngA As Range, myRngA As Range Set Rng = Range("B3:W3,b7:w8,b12:w12,d13:w13,d17:w18,d22:w23") Set myRng = Intersect(Target, Rng) If myRng.Interior.ColorIndex = xlColorIndexNone Then myRng.Interior.ColorIndex = 37 Else If myRng.Interior.ColorIndex = 37 Then myRng.Interior.ColorIndex = 45 Else myRng.Interior.ColorIndex = xlColorIndexNone End If End If Cancel = True End Sub とここまではあるのですが、これをどう改造すればSheet2の同じセルの色もかわるのでしょうか？ 宜しくお願いいたします
- ベストアンサー
- オフィス系ソフト
- ＥＸＣＥＬマクロでのシート間のデータ同期方法
質問させていただきます。 ＥＸＣＥＬにて、"シート１"のA1～C3と"シート２"のD4～F6を 同期化したく考えております。 ・いわゆる一方のシートが「読み取り専用」になってしまうリンク貼り付けではなく、シート1、シート2相互が書き換え可能の同期化です。 ・A1とD4、B3とE6、のように互いに照合箇所のセル同士を同期反映させたいと考えております。 なお、他の質問を参照したところ、 シート１のA1とシート２のD4の単一セルを同期かする方法は確認できました。（以下参照） ***************************************************************** シート１のコードは Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Worksheets("シート２").Range("D4") = Target End If End Sub シート２のコードは Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$4" Then Worksheets("シート１").Range("A1") = Target End If End Sub *************************************************************** これを参考にVBAの シート１のコードエディターに Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$2" Then Worksheets("シート２").Range("D5") = Target End If End Sub シート２のコードエディターに Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$5" Then Worksheets("シート２").Range("A2") = Target End If End Sub というように追記していったのですが、エラーとなってしまいます。 お詳しい方がおられましたらお願いいたします。
- ベストアンサー
- オフィス系ソフト
- VBA Intersectで範囲の記述
エクセル2000です。 Intersectで範囲の記述で、名前が定義された範囲、myRng と その2列右どなりを指定したいのですが、 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Union(Range("myRng"), Range("myRng").Offset(, 2))) Is Nothing Then Exit Sub MsgBox Target.Address End Sub のようにUnionを使わなければできないでしょうか？ myRngがA1:A10であれば、 If Intersect(Target, Range("A1:A10,C1:C10")) Is Nothing Then Exit Sub と簡単に記述できるのですが。
- ベストアンサー
- その他MS Office製品
- エクセルのマクロについて教えていただきたいのですが・・・
見積書を作成しているんですが、1枚目のシート（見積書）に明細が書ききれなかった時に、マクロを実行すると、『明細書』と言う名前のシートが(1)～(5)枚目まで追加され、各シートの小計を1枚目のシートに書き出す・・・と言うマクロを作りたいのですが、うまくいかずに困っています＞＜ 追加されるシートの元となる『見積もりマスター』と言うシートがあって、そのシート内でそれぞれのシートの小計は取れるのですが・・・ 下記のマクロの中に何か追加すればうまくいく方法はありますか？？ （明細書は追加する時もあれば追加しない時もあってその都度、使う人が、最大5枚まで何枚追加するかを決めるそうです。） Sub Macro1() Dim cnt As Integer Dim wkNum As Double Dim ws As Worksheet For Each ws In Worksheets If Left(ws.Name, 4) = "明細書(" Then If IsNumeric(Mid(ws.Name, 5, 1)) Then wkNum = Val(Mid(ws.Name, 5, 1)) If cnt < wkNum Then cnt = wkNum End If End If End If Next ws If cnt >= 5 Then MsgBox ("明細書シートが既に５枚以上あるため追加できません") Exit Sub Else Sheets("明細マスター").Copy after:=Sheets(Worksheets.Count) ActiveSheet.Name = "明細書(" & cnt + 1 & ")" End If End Sub マクロ自体をあまり理解できてなくて、会社の人や、ここで教えていただいて進めているので、出来ればそのままコピーして使用できるようにしていただけるとありがたいです。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロ
セルの値が変わったら動くマクロですが、2つ書くとエラーが出ます。 どのように直したらいいでしょうか？ Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address If Intersect(Target, Range("EK22")) Is Nothing Then Exit Sub Else Range("EK24:EM28").Select Selection.ClearContents End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("EK24")) Is Nothing Then Exit Sub Else Range("EK27:EM28").Select Selection.ClearContents End If End Sub
- ベストアンサー
- Excel（エクセル）
- VBAでChangeイベントを使いたい
今エクセルで出納を作ってます。 シート1には Ａ日付 Bコード C金額 D 消費税区分 E 金額 F,G,H,Iにも同様に貸方科目を入れてます。 シート2にはAコードB科目を上から下にずっといれてます。 それで借方金額Ｃの金額をEに飛ばすこと VLOOKUPでＢのコードに対応する科目を表示すること 上記をChangeイベントでやりたいのですが、金額転記はうまくいったのですが、 VLOOKUPの方が標準モジュールではうまくいくものの、シートモジュールに移すとうまく 行きません。おそらく根本的な理解がかけてるからだと思います。 今の記述は下記 シート1に Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 1 Or Target.Row > 100 Then Exit Sub If Target.Column <> 5 Then Exit Sub Dim Cnt As Long For Cnt = 2 To 100 Range("I" & Cnt).Value = Range("E" & Cnt).Value Next Cnt If Target.Row = 1 Or Target.Row > 100 Then Exit Sub If Target.Column <> 3 Then Exit Sub End Sub 標準モジュールに Option Explicit Sub 科目() Dim シート1 As Worksheet Dim シート2 As Worksheet Set シート1 = Worksheets("出納") Set シート2 = Worksheets("科目") Dim myR On Error GoTo ErrorHandler myR = Application.WorksheetFunction.VLookup(シート1.Range("B2"), シート 2.Range("A2:B87"), 2, False) シート1.Range("C2").Value = myR Exit Sub ErrorHandler: シート1.Range("C2").Value = "該当無し" End Sub 大変素人な質問ですみませんが、ご回答いただけると嬉しいです。 基礎の本やレファレンス本は見たのですが、標準モジュールでできること がなぜシートモジュールでできないかが全く分かりません。 よかったらお教えください。
- 締切済み
- 財務・会計・経理
- VBAでオートフィルを使って指定する文字列を含むものを表示させたい
VBAを使って、セルD1に入力した文字列を検索するマクロを作りたいと思っています。 私は初心者で前に似たようなものを作ってもらって それを加工しようとしたのですが、うまくいきませんでした。 以前は完全に一致するもので表示でしたが、 今回は含むものを表示させたいです。 ワイルドカードは＊をつけるのはわかるのですが、 いろいろやってみましたがダメでした。（単純なことかもしれないですけど） Private Sub Worksheet_Change(ByVal Target As Range) Dim myRng1 As Range Dim myRng2 As Range Set myRng1 = Target.Cells(1) If Application.Intersect(myRng1, Range("D1")) Is Nothing Then Exit Sub Set myRng2 = Range("D1").CurrentRegion With myRng2 If myRng1 = "" Then ActiveSheet.ShowAllData Else .AutoFilter Field:=4, Criteria1:=myRng1.Value End If End With End Sub
- 締切済み
- その他（プログラミング・開発）
- マクロが動きません
以下のようなプログラムでC3の値が変わるたびにA10の値に1を加えていきG3,H3が両方0になったらA10の値も0にする。C5の値が変わるたびにA15の値に1を加えJ3,K3が共に0になったらC5も0にするようにしました。 しかし、動作しません。 このシートの3行目は＝シート名！セル番号 という形でほかのシートのセルの値が表示されるようになっています。G3、H3、J3、K3に手動で数値を入力した場合 は動作します。 ほかのシートのセルの値を表示させたセルの値が変化しても動作させる方法はないでしょうか＞ Private Sub worksheet_change(ByVal target As Range) With target If .Count > 1 Then Exit Sub If IsNumeric(.Value) = False Then Exit Sub If IsEmpty(.Value) = True Then Exit Sub If Not .Row = 3 Then Exit Sub Select Case .Column Case 3 Range("A10").Value = Range("A10").Value + 1 Case 5 Range("A15").Value = Range("A15").Value + 1 End Select End With If Range("g3").Value = 0 And Rang("h3").Value = 0 Then Range("A10").Value = 0 If Range("j3").Value = 0 And Rang("k3").Value = 0 Then Range("A15").Value = 0 End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル マクロ 追加
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub End If If Not Intersect(Target, Range("B1:C15")) Is Nothing And Target.Value = "" Then Exit Sub End If Dim c As Worksheet Dim flag As Boolean flag = False For Each c In Worksheets If c.Name = Target.Value Then flag = True Next If flag = False Then Exit Sub If Target.Address = "$C$2" Or Target.Address = "$C$3" Or Target.Address = "$C$4" _ Or Target.Address = "$C$5" Or Target.Address = "$C$6" Or Target.Address = "$C$7" _ Or Target.Address = "$C$8" Or Target.Address = "$C$9" Or Target.Address = "$C$10" _ Or Target.Address = "$C$11" Or Target.Address = "$C$12" Or Target.Address = "$C$13" _ Or Target.Address = "$C$14" Or Target.Address = "$C$15" Then Worksheets(Target.Value).Visible = True Worksheets(Target.Value).Select Else End If End Sub セルに文字が打っています シート名とセルが一緒の文字のとき移動するマクロです データがあるセルをクリックするとそのデータ先に飛ぶように 設定したマクロなのですが、 選択するページの文字は全部最初から設定されている黒文字がつかわれているのですが データがあるときは文字の色を変化させたいのですが どうすればいいでしょうか？
- ベストアンサー
- Excel（エクセル）
補足
大変失礼をいたしました。始めてでしたので、とても参考になりましたありがとうございます。 補足説明させて頂きます。 sheet1 の、エクセルシート上にランダムに”りんご”や”いちご”などの品名が記載されております。仮にりんごが横 ”ｋ” 縦”5”の所に記載されており、その下に縦+1～+13段 横-15～+3 のセルに”1”と数値が記入されております。その”1”の文字も色分けがされております。 そのシート全体が元となり、sheet2 の 横 ”Ｂ” 縦”23”のセルに”りんご”と記入したら その下の”1”と色がそのまま反映されるようなマクロを組みたいのですが、どのようにすればよろしいのでしょうか。よろしくお願いいたします。