- ベストアンサー
マクロ 値貼付 oguno
●日付表示をyy-mm-dd(07-03-04)と、したかったのですが構文1では「3/4/2007」の表示になってしまいました。 ●構文2のように修正しましたら、希望の日付表示「07-03-04」になりました。 ●修正箇所 構文1の「Value」を「Copy」と修正し、 「Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False」を追加しました。 ーーーーーーーーーーーーーーーーーーーーーーーー ●お願い 希望の日付表示にはなりましたが、記述の仕方が、これで正しいのかどうか、初心者のため自信がありません。 正しく記述しているのかどうか、ご検証をお願いいたします。 なお、構文１もこのサイトでご指導いただいたものです。 ーーーーーーーーーーーーーーーーーーーーーーーー ●構文１ '未転記のデータがあればデータコピー If WS1Mon > WS2Mon Then If WS2.Cells(StartRow, 2).Value <> "" Then CopyToRow = WS2LastRow + 1 Else CopyToRow = StartRow End If WS2.Cells(CopyToRow, 2).Resize(WS1Mon - WS2Mon, 7).Value = _ WS1.Cells(StartRow + WS2Mon, 2).Resize(WS1Mon - WS2Mon, 7).Value WS2.Cells(CopyToRow, 2).Resize(WS1Mon - WS2Mon, 7).Select Else Selection.Select End If Application.CutCopyMode = False ●構文２ '未転記のデータがあればデータコピー If WS1Mon > WS2Mon Then If WS2.Cells(StartRow, 2).Value <> "" Then CopyToRow = WS2LastRow + 1 Else CopyToRow = StartRow End If WS2.Cells(CopyToRow, 2).Resize(WS1Mon - WS2Mon, 7).Value = _ WS1.Cells(StartRow + WS2Mon, 2).Resize(WS1Mon - WS2Mon, 7).Copy WS2.Cells(CopyToRow, 2).Resize(WS1Mon - WS2Mon, 7).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Else Selection.Select End If Application.CutCopyMode = False
- oguno
- お礼率61% (179/289)
- オフィス系ソフト
- 回答数4
- ありがとう数4
- みんなの回答 （4）
- 専門家の回答
質問者が選んだベストアンサー
こんにちは、ham_kamoです。 WS2.Cells(CopyToRow, 2).Resize(WS1Mon - WS2Mon).NumberFormatLocal ="yy-mm-dd" をコピーする前に入れても、PCによっては日付の形式が変わってしまう、ということなのでしょうか。何が原因なのか、申し訳ありませんが私にはやはりわかりません。（もっとスキルの高い方なら推測できるのかもしれませんが） コントロールパネルの日付の設定は、どのようにするのがベスト、というのはありません。各自の好みです。マクロの中できちんとフォーマットを指定しておけば、その設定に左右されることはないはず…、だと思ってたのですが。でも形式が変わってしまうのですよね。しかしコンパネでは"yy-mm-dd"で設定されていて、マクロの中でも同じ指定をしているのに、「3/4/2007」という表示になるというのは、不可解です。 つい最近、VLOOKUPなどを多用した複雑な式を含んだ、やはり5000行くある表を、同じようにCopyしてPasteSpecialすると、30秒くらいかかった（自分的にはストレスでした）ので、.Value = .Value という値を直接代入する方式に変更したら劇的に早くなり、そのようにこちらのマクロも変更したのですが、数式が入ってなかったら5000行くらいあってもCopy＆PasteSpecialでもたいして時間はかかりません。 それで、前回の質問で詳細を聞かずに勝手にコピーの処理を変更してしまったのですが、C列～H列のデータというのは、複雑な数式などでなく、単なるデータなのでしょうか。もしそうであれば、CopyしてPasteSpecialするという方法でも、処理速度面でそんなに問題はないので、いったんそれに戻しましょう。 とりあえず再度マクロを全文転載します。 Private Sub CommandButton1_Click() Dim WS1 As Worksheet, WS2 As Worksheet Dim i As Integer, j As Integer, CopyToRow As Integer Dim CopyMonth As Integer, WS1Mon As Integer, WS2Mon As Integer Const StartRow As Integer = 6 'データが入力されている最初の行番号 Set WS1 = Worksheets("入力画面") '月毎のシート名 Set WS2 = Worksheets("年間成績") '年間のシート名 Dim WS2LastRow As Integer '3/1追加 'シート１が未入力（月の取得が不可能な場合）は中止 If WS1.Cells(StartRow, 2).Value = "" Then Exit Sub Application.ScreenUpdating = False 'シート保護解除 WS2.Unprotect '月ごとのシートから転記する月を取得 CopyMonth = Month(WS1.Cells(StartRow, 2).Value) '月ごとのシートから、その月の入力済みデータ数を取得 'C列にデータが入れば自動的に日付が入るようにあらかじめB列に数式が '組み込まれているため、B列の中から空文字列でないセルをカウントする。 For i = StartRow To WS1.Cells(Rows.Count, 2).End(xlUp).Row If WS1.Cells(i, 2).Value <> "" Then WS1Mon = WS1Mon + 1 Next '年間のシートからその月の転記済みデータ数を取得 If WS2.Cells(StartRow, 2).Value <> "" Then WS2LastRow = WS2.Cells(Rows.Count, 2).End(xlUp).Row Else WS2LastRow = StartRow End If For i = StartRow To WS2LastRow If Month(WS2.Cells(i, 2).Value) = CopyMonth Then WS2Mon = WS2Mon + 1 Next '未転記のデータがあればデータコピー If WS1Mon > WS2Mon Then If WS2.Cells(StartRow, 2).Value <> "" Then CopyToRow = WS2LastRow + 1 Else CopyToRow = StartRow End If WS1.Cells(StartRow + WS2Mon, 2).Resize(WS1Mon - WS2Mon, 7).Copy WS2.Cells(CopyToRow, 2).PasteSpecial Paste:=xlValues Else Selection.Select End If Application.CutCopyMode = False 'シート保護 WS2.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Application.ScreenUpdating = True End Sub
その他の回答 (3)
- Wendy02
- ベストアンサー率57% (3570/6232)
こんばんは。Wendy02です。 >・構文１では、同じ表示「3/4/2007」となりました。 コードをみると、内部データがシリアル値なら、単に、データが移動しているだけで、貼り付ける前に、書式設定をして、その上に、Value を貼り付けて、それがダメになるというのは、考えられません。シリアル値でないなら、また別です。その場合は、.Value そのままでは出来ません。 本来、別のプログラムで、ワークシート上のデータを、日付型のデータにしなければなりません。大方、そういう所に問題の解決があるような気がします。 結果で、こういうようになったと言っても、元のデータがどのようなデータかサンプルもみていないし、セルの書式も確認せずに話しを進めていますから、なんともいえない部分があります。 ただし、 >最終的な構文全文をご記載頂けないでしょうかお願い致します。 私のほうでは、コードが読めませんので、それは書けません。ただ、 ham_kamoさんがおっしゃるように、 >数式が入ってなかったら5000行くらいあってもCopy＆PasteSpecialでもたいして時間はかかりません。 でも良いかもしれません。 それと、 構文２の WS2.Cells(CopyToRow, 2).Resize(WS1Mon - WS2Mon, 7).Value = _ WS1.Cells(StartRow + WS2Mon, 2).Resize(WS1Mon - WS2Mon, 7).Copy このコードが通るのがヘンです。 WS1.Cells(StartRow + WS2Mon, 2).Resize(WS1Mon - WS2Mon, 7).Copy この行をコピーしたという戻り値－True が返りますから、それが、 WS2.Cells(CopyToRow, 2).Resize(WS1Mon - WS2Mon, 7).Value に、True の値が、貼り付けられるはずです。
お礼
Wendy02様 質問の表現が不適切な為、色々とご迷惑をお掛けいたしました。 構文１の方法で完成いたしました。 ありがとうございました。 追 体調を崩し、御礼が遅くなり申し訳ございません。 oguno
- ham_kamo
- ベストアンサー率55% (659/1197)
こんにちは、前回回答したham_kamoです。 Wendy02さんの回答で少し見えてような気がします。 値をValueでコピーすると、yy-mm-dd が m/d/yyyy に変わってしまう、という現象は私の環境では再現しなかったので、原因がわからずギブアップしたのですが、NumberFormatLocal = "yy-mm-dd" をコピーの後に入れていたのが悪かったようですね。 私の環境で再現しなかったのは、Wendy02さんの書かれている、 > それと、本来、コンパネの地域の日付設定から、そのようになったような気がします。 ここの設定がogunoさんと異なっていたかもしれません。 Wedny02さんの回答を少し修正させていただくと、Ｂ列以外の列は数値として表示しないといけないので、 WS2.Cells(CopyToRow, 2).Resize(WS1Mon - WS2Mon).NumberFormatLocal ="yy-mm-dd" とすればよいと思います。 なお、先の質問で私が最初に書いたVBAは、構文２のようにCopyしてPasteSpecialする方法でしたが、データ数が5000行を超えるということで、この方法では時間がか可能性が高いと思い、配列のValueで直接代入する方法に変更しました。それから日付の形式がおかしくなってしまったのですね。 あえて構文２で方法で記述するのであれば、 WS2.Cells(CopyToRow, 2).Resize(WS1Mon - WS2Mon, 7).Value = _ この１行は不要です。（本当にエラーが出ないのが不思議です） いったんSelectする必要はなく、直接起点となるセルを指定して貼り付ければいいので、 WS1.Cells(StartRow + WS2Mon, 2).Resize(WS1Mon - WS2Mon, 7).Copy WS2.Cells(CopyToRow, 2).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False でいいかと思います。（最後の行は、コピーした範囲の枠が点滅するのを解除するコードです）
補足
この質問にお目を止めて頂き有難うございます。 --------- ● >コンパネの地域の日付設定の件 Wedny02さんにも御願いいたしましたが、ham_kamo様にもご指導頂きたく御願い申し上げます。 --------- ・設定した記憶は無いのですが、yy-mm-ddに設定していました。 ・本来の質問と違ってしまい申し訳ないのですが、どのように設定するのがベストなのでしょうか。 御指導いただければ幸でございます。 ・設定が違うと結果が異なるのであれば、設定を合わさせていただき、テストをしご報告申し上げます。 ●取敢えず、yy-mm-ddとyyyy/mm/ddの設定で、テストしましたが、 「XP Excel 2002」 ・構文１では、同じ表示「3/4/2007」となりました。 ・構文２方式ではでは、「07-03-04」となりました。 「ME Excel 2000」 ・構文１では、「07-03-04」となりました。 ・構文２方式ではでも、「07-03-04」となりました。 ＊下記の件御願いできれば、落ち着いてもう一度試行し整理いたします。 ●上記のようになりましたが、色々と修正いたしましたので、正直正しく修正出来ているのか、自信が無くなりました。 ・またかと、お叱りを受けるかもしれませんが、最終的な構文全文をご記載頂けないでしょうかお願い致します。 ・構文１タイプ（高速処理） ・構文２タイプ お手数をお掛け致しますが、説明コメントは出来るだけ詳細にお願い出来れば幸でございます。 勉強の為にも、２ファイル作成し・構文１タイプ（高速処理）と・構文２タイプを実感してみたいと思っております。 --------- 身勝手な御願いばかりで申し訳ございませんが、よろしく御願い申し上げます。 oguno
- Wendy02
- ベストアンサー率57% (3570/6232)
こんにちは。 Excelでは、日付データは、貼り付ける前に、書式を整えるというのが、原則なんです。貼り付けた後ですと、データに、型のキャスティングが起きてしまって、戻せなくなってしまいす。 しかし、構文２は、よく、それでエラーが出ないか、不思議だと思います。 今回は、.Value = .Value で、配列の貼り付けになっているので、そういうことになるので、もし、Copy メソッドなら、書式も貼り付きますから、そのような現象は起こらないはずです。 そのままを活かすには、 貼り付ける前に、 WS2.Cells(CopyToRow, 2).Resize(WS1Mon - WS2Mon, 7).NumberFormatLocal ="yy-mm-dd" としてから、構文1を行えばよいはずです。 それと、本来、コンパネの地域の日付設定から、そのようになったような気がします。 なお、関係はありませんが、VB Editor 内は、確か、日本など向けは、米語仕様になっていたような気がします。
補足
御指導有難うございます。 ●＜Excelでは、日付データは、貼り付ける前に、書式を整えるというのが、原則なんです。 言い訳になりますが初心者の為、よく判りませんでした。 肝に銘じます。 お叱り有難うございました。 ●＜本来、コンパネの地域の日付設定から、そのようになったような気がします。 ・設定した記憶は無いのですが、yy-mm-ddに設定していました。 ・本来の質問と違ってしまい申し訳ないのですが、どのように設定するのがベストなのでしょうか。 御指導いただければ幸でございます。 ・設定が違うと結果が異なるのであれば、設定を合わさせていただき、テストをしご報告申し上げます。 oguno
関連するQ&A
- マクロ 値貼付 oguno
Value = .Value という値を直接代入する方式に変更し早く処理をしたい。 そのようにこちらのマクロを変更したいのですが、ご教示下さい。 '未転記のデータがあればデータコピー If WS1Mon > WS2Mon Then If WS2.Cells(StartRow, 2).Value <> "" Then CopyToRow = WS2LastRow + 1 Else CopyToRow = StartRow End If WS1.Cells(StartRow + WS2Mon, 2).Resize(WS1Mon - WS2Mon, 7).Copy WS2.Cells(CopyToRow, 2).PasteSpecial Paste:=xlValues Else Selection.Select End If
- ベストアンサー
- オフィス系ソフト
- エクセル マクロ修正
シート１～５まであります。別に情報シートを作成しています それぞれ同じ原本から作成しています 全部のシートにＡ１～Ａ１０のセルに日付、B1～B10のセルに文字など入力がするところがあります 入力はＡ１から順番に入れていきます 例えば 保存ボタンを作成しておく シート１のA1に日付、B１に”文字”を入力し、保存ボタンをおす 情報シートに日付と内容が一致する情報がなければ、 情報シートのＡ列にシート名、Ｂ列に日付、C列に入力した内容が 空白のところに出力される ボタンのマクロがCommandButton1_Clickとしたら Private Sub CommandButton1_Click() 検索 End Sub 標準モジュールに Sub 検索() Dim c As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws1LastRow As Long Dim ws2LastRow As Long Set ws1 = Sheets("情報シート") Set ws2 = ActiveSheet If ws2.Range("A1").Value = "" Or ws2.Range("B1").Value = "" Then MsgBox "検索する日付もしくは語句が入力されていません。", vbCritical Exit Sub End If If ws1.Range("A1").Value = "" Then ws1LastRow = 0 Else ws1LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row End If ws2LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row For Each c In ws1.Range(ws1.Cells(1, "B"), ws1.Cells(Rows.Count, "B").End(xlUp)) If c.Value2 = ws2.Cells(ws2LastRow, "A").Value2 Then If c.Offset(0, 1).Value = ws2.Cells(ws2LastRow, "B").Value Then MsgBox "既にデータが存在します", vbInformation Exit Sub End If End If Next ws1.Cells(ws1LastRow + 1, "A").Value = ws2.Name ws1.Cells(ws1LastRow + 1, "B").Resize(1, 2).Value = ws2.Cells(ws2LastRow, "A").Resize(1, 2).Value MsgBox "データを追加しました", vbInformation Set ws1 = Nothing Set ws2 = Nothing End Sub これを教えて頂き作っていたのですが 別のシートを作成しこのプログラムを応用していたのですが うまく起動しないため再度投稿しました 今度のやつは固定でやろうと思っていていじったのですが 別の欄の文字が表示してしまった 結合セルB2：C4に日付を入れる 結合セルL２：L３０に内容を入れるようにしたいのですが ここだけのセルを参照するようにしたいのです。 どうすればいいでしょうか？ 試したことAをB2にかえ、BをL２にしたら変なことになりました・・・
- ベストアンサー
- Excel（エクセル）
- マクロの簡素化
下記マクロです。 Range("AE6:AE1005").Select Selection.ClearContents Selection.Interior.ColorIndex = xlNone If Range("AD6").Value > 5 Then Range("AE6") = "*" Range("AE6").Select With Selection.Interior .ColorIndex = 3 End With Else End If If Range("AD7").Value > 5 Then Range("AE7") = "*" Range("AE7").Select With Selection.Interior .ColorIndex = 3 End With Else End If If Range("AD8").Value > 5 Then Range("AE8") = "*" Range("AE8").Select With Selection.Interior .ColorIndex = 3 End With Else End If 中略（セルを一個づつ指定しています） If Range("AD1004").Value > 5 Then Range("AE1004") = "*" Range("AE1004").Select With Selection.Interior .ColorIndex = 3 End With End If If Range("AD1005").Value > 5 Then Range("AE1005") = "*" Range("AE1005").Select With Selection.Interior .ColorIndex = 3 End With Else End If Range("AE3").Select 有るセルを参照しその値が５以上だったら別のセルに＊マークとセルに色を付けるマクロですが、一個づつセル指定をしていますが、何とか短く出来ないでしょうか？ お分かりになる方宜しくお願い致します。
- ベストアンサー
- その他（プログラミング・開発）
- マクロ実行後、画面がちかちかしない方法
こんばんわ！ VBAを実行すると、画面がちかちかします。 シートを行ったり来たりしているせいでしょうね？ 自分で、色々やってみたのですが、エラーばかりで全然できません。 シートを行ったり来たりしなくてもいいＶＢＡを作るには、どこを直せばいいでしょうか。 教えて頂けませんか？ （現在のＶＢＡ） (1)「Data!FB63376,FG63376,FI63376」を「拾い出し!K4」にコピー＆ペースト 値が入っている場合、下の行に貼付け。 Sub Macro1() Range("FB63376,FG63376,FI63376").Select Range("FI63376").Activate Selection.Copy Sheets("拾い出し").Select If Range("K4").Value = "" Then Range("K4").Select Else Range("K" & Rows.Count).End(xlUp).Offset(1).Select End If ActiveSheet.Paste Sheets("Data").Select (2)「Data!FO63367:FQ63372」を「拾い出し!O4」に値のみをコピー＆ペースト 値が入っている場合、下の行に貼付け。 Range("FO63367:FQ63372").Select Selection.Copy Sheets("拾い出し").Select If Range("P4").Value = "" Then Range("P4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Else Range("P" & Rows.Count).End(xlUp).Offset(1).Select End If Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Data").Select Application.CutCopyMode = False End Sub 以上です。 お分かりになる方教えて頂けませんか？ 宜しくお願いします。
- ベストアンサー
- オフィス系ソフト
- 複数行コピー、貼り付け実行時エラー1004
ユーザー側が任意の場所を選択コピー し(2行毎) また 任意の位置に貼り付ける動作ですが 1回目のコピー、貼り付けは正常動作しますが 再度 コピー(任意の場所),貼り付け時に1004実行エラーが発生します。 下記はコードです。 どうかご教授お願いいたします。 Dim StartRow As Long, LastRow As Long, SRC As Long Sub コピー() If ActiveCell.Row < 76 Then Exit Sub StartRow = ActiveCell.Row: SRC = Selection.Rows.Count If (ActiveCell.Row Mod 2) = 0 Then StartRow = ActiveCell.Row If (Selection.Rows.Count Mod 2) = 0 Then LastRow = StartRow + Selection.Rows.Count - 1 Else LastRow = StartRow + Selection.Rows.Count End If Else StartRow = ActiveCell.Row - 1 If (Selection.Rows.Count Mod 2) = 0 Then LastRow = StartRow + Selection.Rows.Count + 1 Else LastRow = StartRow + Selection.Rows.Count End If End If ActiveSheet.Range(ActiveSheet.Cells(StartRow, 1), ActiveSheet.Cells(LastRow, 19)).Copy End Sub Sub 貼付け() If ActiveCell.Row >= 76 Or Application.ClipboardFormats(1) <> -1 Then ActiveSheet.Unprotect If (ActiveCell.Row Mod 2) = 0 Then StartRow = ActiveCell.Row Else StartRow = ActiveCell.Row - 1 End If ActiveSheet.Paste Destination:=Cells(StartRow, 1): Application.CutCopyMode = False ActiveSheet.Protect End If End Sub
- 締切済み
- Visual Basic
- 簡単マクロ編集
Sheets("Sheet1").Select ←Range("A3:H8") Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet4").Select Application.CutCopyMode = False ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True 下方にこの操作を繰り返ししたいのですが Dim i As Long Worksheets("Sheet1").Select For i = 3 To 100 Step 6 If Cells(i, "A") = "" Then Exit Sub End If Cells(i, "A").Resize(6, 8).Copy Destination:=Worksheets("Sheet2").Range("A3:H8") Next i 貼付けは値で貼り付けたいと思います。 どう組み合わせればよいですか？
- ベストアンサー
- その他MS Office製品
- 再質問 エクセルの表の列の最下行から指定数の・・
お世話になっております。 3日前にここでご回答いただいて解決したと思ったのですが、実シートで作業開始早々に不都合が出たので追加のHELPのお願いです。 各列の17行目以降に行方向にデータが入った表の下から30個のデータのMaxを求める関数のVBAを教わって早々に作業を開始したのですが、なぜか最下行を含まないVBAと、計算式の入った列では結果が「#VALUE!」となり、最下行を含むVBAの場合は、計算式の入った列の結果は「0」となってしまいます。 試しに別のシートで数値の列とその数値に定数をかけた列を作って試してみましたがうまく行きます。 また、対象のシートのセルの書式は数値になっています。 具体的な数式は =IF(F127="","",F127*5) というような単純な計算式で日付が入るような特殊な計算はやっていません。 項目 数値A 計算値A 数値B 数値B 数値C ------------------------------------------------------------------- 平均 1.1197 #VALUE! 46.6133 #VALUE! 44.6767 σ 0.0008 #VALUE! 2.5940 #VALUE! 0.2128 最小 1.117 0.000 42.100 0.000 44.300 最大 1.121 0.000 51.100 0.000 45.100 ＜最下行を含む場合＞ Function sfMax(Rng As Range, Optional bd) As Double Dim LastRow As Long Dim MyCol As Long Dim tgRng As Range Dim Border As Long Dim StartRow As Long Const DefBorder = 30 StartRow = 17 'データ開始行 If IsMissing(bd) Then Border = DefBorder '省略された場合の閾値 Else If ((bd = 0) Or (bd = "")) Then Border = DefBorder '省略された場合の閾値 Else Border = bd End If End If MyCol = Rng.Column LastRow = Cells(Rows.Count, MyCol).End(xlUp).Row If LastRow > StartRow + Border - 1 Then StartRow = LastRow - Border + 1 End If Set tgRng = Range(Cells(StartRow, MyCol), Cells(LastRow, MyCol)) sfMax = WorksheetFunction.Max(tgRng) End Function ＜最下行を副含まない場合＞ Function sfSTDEV(Rng As Range, Optional bd) As Double Dim LastRow As Long Dim MyCol As Long Dim tgRng As Range Dim Border As Long Dim StartRow As Long Const DefBorder = 30 StartRow = 17 'データ開始行 If IsMissing(bd) Then Border = DefBorder '省略された場合の閾値 Else If ((bd = 0) Or (bd = "")) Then Border = DefBorder '省略された場合の閾値 Else Border = bd End If End If MyCol = Rng.Column LastRow = Cells(Rows.Count, MyCol).End(xlUp).Row If LastRow > StartRow + Border - 1 Then LastRow = LastRow - 1 StartRow = LastRow - Border + 1 End If Set tgRng = Range(Cells(StartRow, MyCol), Cells(LastRow, MyCol)) sfSTDEV = WorksheetFunction.StDev(tgRng) End Function
- ベストアンサー
- Excel（エクセル）
- ファイルオープン時のマクロが一部実行されない
いつも回答して頂き、ありがとうございます。感謝感謝です。 ファイルオープン時にApplication.Runで３つのマクロを実行させているのですが、最後のマクロだけ実行されません。どうしてでしょうか？もしかして、前の２つで『一覧シート』を除外するマクロを実行しているからでしょうか？御指導の程宜しくお願いいたします。 1番目に実行するマクロ Sub 特定のシート以外の最終履歴と次回予定日を算出する() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Integer c = 3 Do While ws.Cells(2, c).Value <> "" With ws.Cells(6, c) .FormulaR1C1 = "=MAX(R8C:R10000C)" If .Value = 0 Then .Value = "履歴無し" ws.Cells(7, c).ClearContents Else .Value = .Value ws.Cells(7, c) = DateAdd("d", ws.Cells(5, c), DateAdd("m", ws.Cells(4, c), DateAdd("yyyy", ws.Cells(3, c), ws.Cells(6, c)))) End If End With c = c + 1 Loop End If End If Next End Sub ２番目に実行するマクロ Sub 期限の未達と到達を色で分ける() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Long Dim res As Variant For c = 3 To ws.Cells(7, Columns.Count).End(xlToLeft).Column If IsDate(ws.Cells(7, c)) Then If ws.Cells(7, c) > Date Then res = 8 Else res = 3 End If Else res = xlNone End If ws.Cells(7, c).Interior.ColorIndex = res Next c End If End If Next End Sub ３番目に実行するマクロ Sub 各シートの情報を一覧へ転記する() Dim d As Integer Dim retu As Integer d = 3 Do While Cells(d, 2).Value <> "" With Worksheets(Worksheets("一覧").Cells(d, 2).Value) .Activate retu = .Range("IV7").End(xlToLeft).Column .Range(Cells(7, 3), Cells(7, retu)).Copy End With With Worksheets("一覧") .Activate Cells(d, 3).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End With d = d + 1 Loop End Sub
- ベストアンサー
- オフィス系ソフト
- セルの値が0はクリアするマクロ
エクセル2003です。 ある集計表において 4行目のH列からAM列まで 数値データがあります。 最終行は常に変化します この表内にてセルの値が0のセルは セル内を空白にしたいです。 以下のマクロを作成しましたが If Cells(処理行, 8).Value = 0 Then Cells(処理行, 8).ClearContents をあと(処理行, 13)から(処理行,31) まで記述しなければなりません。 構文的にも処理的にも不利？ と思うので、なにかいい方法を教えてください。 Sub 数字0クリア() '2012年2月3日節分 Dim 最終行 '最終列をG列で求めます 最終行 = Cells(Rows.Count, 7).End(xlUp).Row Application.ScreenUpdating = False For 処理行 = 4 To 最終行 If Cells(処理行, 8).Value = 0 Then Cells(処理行, 8).ClearContents End If If Cells(処理行, 9).Value = 0 Then Cells(処理行, 9).ClearContents End If If Cells(処理行, 10).Value = 0 Then Cells(処理行, 10).ClearContents End If If Cells(処理行, 11).Value = 0 Then Cells(処理行, 11).ClearContents End If If Cells(処理行, 12).Value = 0 Then Cells(処理行, 12).ClearContents End If If Cells(処理行, 13).Value = 0 Then Cells(処理行, 13).ClearContents End If Next 処理行 Application.ScreenUpdating = True MsgBox "終了しました" End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロで繰り返し処理
当方マクロ初心者ですが下記のマクロをCheckBox0～CheckBox23についてコピーするセルを変化させながら繰り返し処理を行いたいのですが、簡単なループ処理で行えますか？ 教えていただければ幸いです。 If CheckBox0.Value = True Then Worksheets("sheets1").Activate 行 = Worksheets("sheets1").Range("e7") 行 = 行 Worksheets("sheets1").Range("g7:t7").Copy Windows("Books1.xls").Activate Sheets("sheets1").Select Range(Cells(行, 15), Cells(行, 15)).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End If
- ベストアンサー
- Visual Basic
お礼
ありがとうございました。 QNo.2823108 マクロ 値貼付でご指導をいただけましたので、こちらは締め切りさせていただきます。 捕捉ばかりで、長くなると申し訳ないと思い、別質問に切り替えましたが、質問の仕方が不適切なようでした。 注意いたします。 ただ、ham_kamo様にご指導いただければ幸いと思いあのような質問の仕方しました心情はご賢察下さい。 本当にありがとうございました。
補足
ham_kamo様 ＞再度マクロを全文転載します。 ●ありがとうございました。 ------------- ＞.Value = .Value という値を直接代入する方式に変更したら劇的に早くなり ●こちらの構文も勉強させていただきたいと思いますので、全文お願い出来ないでしょうか。 ・尚回答は下記質問に転載してください。 QNo.2823108 マクロ 値貼付 oguno ------------- ●これだけご指導いただきながら、ポイントが少なく申し訳ないと思い 新しい質問に致しました。 ●連絡が途切れますと困りますので、QNo.2823108 マクロ 値貼付 oguno にご回答いただけましたら、こちらを締め切らせていただきます。 ●体調を崩し、遅くなりましたことお詫びいたします。 oguno