エクセルマクロで月を指定して別シートに表示する方法

このQ&Aのポイント
  • エクセルのマクロを使用して、指定した月を別のシートに表示することは可能ですか?
  • 開始日の検索で、指定した月のデータだけを表示する方法を教えてください。
  • 下記のコードを修正して、指定した月のデータを別のシートに表示するようにしてください。
回答を見る
  • ベストアンサー

エクセル、マクロにて月を指定して別シートに表示はできるのでしょうか?

エクセル、マクロにて月を指定して別シートに表示はできるのでしょうか? 毎度毎度申し訳ありません。開始日の検索で、5月と打っただけ5月分だけ表示6月とうったら6月が出て来る方法なんてあるのでしょうか?ありましたら、下記のコードをどう直せいいか教えて頂けますでしょうか?宜しくお願い致します。 【作業内容:場所と月を検索、さらに要らない列を消し、別シートに表示】【検索月はC】  A B   C     D     E     F   G   H    I   J    K 部署 No.  開始日  終了日   担当者  設備  刃名 枚数  内容 工数 備考 茨城 1 2010/5/7  2010/5/10  B緒  L型   K  16枚  研削 6.00 東和電気 東京 2 2010/6/7  2010/6/8   B緒  L型   K  16枚  研削 6.83 東和電気 茨城 3 2010/5/18  2010/5/19  B緒  L型   K  16枚  研削 1.50 東和電気 茨城 4 2010/5/16  2010/5/19  B緒  L型   K  16枚  研削 6.83 東和電気 茨城 5 2010/6/10  2010/6/10  B緒  L型   K  16枚  研削 6.83 東和電気 ↓ A  B   C     D    E     F   部署 No.  開始日  担当者  内容   工数 茨城 1 2010/5/7  B緒   研削   6.00 茨城 3 2010/5/16  B緒  掃除   6.83 茨城 4 2010/5/18  B緒  出荷   1.50 【コード】 Sub 検索() Dim R As Long Dim Row2 As Long '●Sheet2書込み行 Sheets("集計表").Range("A5").CurrentRegion.Clear Sheets("集計表").Range("A5:F5").Value = Array("依頼部署", "依頼書No.", "研磨開始日", "担当者", "作業内容", "作業内容", "工数") Row2 = 5 For R = 2 To Sheets("日報").Cells(Rows.Count, "A").End(xlUp).Row If Sheets("日報").Cells(R, "A") = Sheets("集計表").Range("A2") And _ Sheets("日報").Cells(R, "C") >= Sheets("集計表").Range("B2") And _ Sheets("日報").Cells(R, "C") <= Sheets("集計表").Range("C2") Then Row2 = Row2 + 1 Sheets("集計表").Cells(Row2, "A").Value = Sheets("日報").Cells(R, "A").Value Sheets("集計表").Cells(Row2, "B").Value = Sheets("日報").Cells(R, "B").Value Sheets("集計表").Cells(Row2, "C").Value = Sheets("日報").Cells(R, "C").Value Sheets("集計表").Cells(Row2, "D").Value = Sheets("日報").Cells(R, "E").Value Sheets("集計表").Cells(Row2, "E").Value = Sheets("日報").Cells(R, "I").Value Sheets("集計表").Cells(Row2, "F").Value = Sheets("日報").Cells(R, "J").Value End If Next R '●結果の並べ替え If Row2 = 5 Then MsgBox "該当データなし!" Else Sheets("集計表").Range("A5:D" & Row2).Sort _ Key1:=Range("B6"), Order1:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom, SortMethod:=xlPinYin Sheets("集計表").Select End Sub

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

  • ベストアンサー
  • myRange
  • ベストアンサー率71% (339/472)
回答No.2

前回も回答しましたのでちょっとお付き合い。。。 INPUTBOXは他の方にお任せして。前回同様のレイアウトで   '--------------------------------------------- ■日報シート■ 見出し行__: 1行目 データ行__: 2行目以降 '--------------------------------------------- ■集計表シート■ __A___B__C___D__E__F__ 1_部署_抽出月_ 2_●●__●__ 3 4 5_部署_NO_開始日_担当者_内容_工数_ 6 7 ●に抽出条件を入れる、 抽出月は、月だけいれる(5月は、5 ) '------------------------------------------------ Sub 検索()  Dim R As Long  Dim Row2 As Long '●Sheet2書込み行  Sheets("集計表").Range("A5").CurrentRegion.Clear  Sheets("集計表").Range("A5:F5").Value = _  Array("依頼部署", "依頼書No.", "研磨開始日", "担当者", "作業内容", "工数")  Row2 = 5 For R = 2 To Sheets("日報").Cells(Rows.Count, "A").End(xlUp).Row  If Sheets("集計表").Range("A2") = Sheets("日報").Cells(R, "A") And _    Sheets("集計表").Range("B2") = Month(Sheets("日報").Cells(R, "C")) Then    Row2 = Row2 + 1    Sheets("集計表").Cells(Row2, "A") = Sheets("日報").Cells(R, "A")    Sheets("集計表").Cells(Row2, "B") = Sheets("日報").Cells(R, "B")    Sheets("集計表").Cells(Row2, "C") = Sheets("日報").Cells(R, "C")    Sheets("集計表").Cells(Row2, "D") = Sheets("日報").Cells(R, "E")    Sheets("集計表").Cells(Row2, "E") = Sheets("日報").Cells(R, "I")    Sheets("集計表").Cells(Row2, "F") = Sheets("日報").Cells(R, "J")  End If Next R '●抽出結果を日付で並べ替え  If Row2 = 5 Then    MsgBox "該当データなし!"  Else    Sheets("集計表").Range("A5:F" & Row2).Sort _       Key1:=Range("C6"), Order1:=xlAscending, _       Header:=xlYes, OrderCustom:=1, MatchCase:=False, _       Orientation:=xlTopToBottom, SortMethod:=xlPinYin  End If  Sheets("集計表").Select End Sub '------------------------------------------------------ ●見やすくするために Sheets("集計表").Cells(Row2, "A").Valueなどの Valueプロパティは省略していますが、 これは意味がわかっていたら省略してもOKです。 今回のコードでは省略してもOKですが、なるべく付けるようにしてください。 ●当然ですが、検査値が月だけですので 当然ですがデータが数年分(2008~2010年)あったとき、 2008年の5月のデータ抽出はできません。 以上です。

loveless-05410
質問者

お礼

今回も回答有難うございます! すごくうれしいです! 前回教えて頂いたものもすごくよかったです。 さっそくやってみます!

loveless-05410
質問者

補足

頼ってばかりで済みませんが、実行時エラーが If Sheets("集計表").Range("A2") = Sheets("日報").Cells(R, "A") And _    Sheets("集計表").Range("B2") = Month(Sheets("日報").Cells(R, "C")) Then のところででます。 なぜでしょうか? 少し変えてみてもうまくいきません!教えてください!

その他の回答 (4)

  • myRange
  • ベストアンサー率71% (339/472)
回答No.5

またまたまた、myRangeです。 日報のデータがたっぷりあるとチェックしにくいでしょうから 日報のC列でエラーになるセルに色をつけましょうか。 下記コードを走らせてください。結果は次のようになります。  赤色: エラーになるデータ  黄色: 空白(エラーにはならない) '--------------------------------- Sub test33()  Dim R As Long  Dim D  On Error Resume Next  For R = 2 To Sheets("日報").Cells(Rows.Count, "A").End(xlUp).Row    Sheets("日報").Cells(R, "C").Interior.ColorIndex = xlNone    If Month(Sheets("日報").Cells(R, "C")) = 99 Then    End If    If Err.Number > 0 Then    Sheets("日報").Cells(R, "C").Interior.ColorIndex = 3    Err.Clear    End If    If Sheets("日報").Cells(R, "C") = "" Then      Sheets("日報").Cells(R, "C").Interior.ColorIndex = 6    End If Next R End Sub '----------------------------------- 以上です。  

loveless-05410
質問者

お礼

何度もすみません。 ありがとうございます! おかげで助かっています。 このコードも使って何とかやってみます!

  • myRange
  • ベストアンサー率71% (339/472)
回答No.4

またまた登場、myRangeです。 >頼ってばかりで済みませんが、実行時エラーが >If Sheets("集計表").Range("A2") = Sheets("日報").Cells(R, "A") And _    Sheets("集計表").Range("B2") = Month(Sheets("日報").Cells(R, "C")) Then >のところででます >少し変えてみてもうまくいきません! エラーが出たら、どのようなエラーかのメッセージが表示されてるはずなのでそれも提示しないといけませんね。 恐らく、「型が一致しません」では? それから、コードを変更するするのはエラーの原因が分かってからですよ。 闇雲に変更してエラーを回避できるわけがありません。 ●まず、データを確認すること。 日報シートのC列にちゃんと日付が入っているかどうか確認してください。 それと、コードをよく見て、実際のセル番地とあっているか確かめてください。 以上です。

loveless-05410
質問者

お礼

回答ありがとうございます! いままでチョコチョコいじってたしかめながら変更していたら何とかなったので 、きっといままで運がよっかったんですね。 データは平気でしたが、見出しが邪魔なだけでした。 有難うございます。

  • layy
  • ベストアンサー率23% (292/1222)
回答No.3

前回からの修正不十分で、場所と日付に対する判定をすべきところをNOを判定しようとしているってことではないですか。 メッセージボックスの機能使って左辺は何、右辺は何、と値を検証してみて下さい。

loveless-05410
質問者

お礼

回答有難うございます!  原因がわかりました! 原因案を出していただきありがとうございます。 大元の見出しが検索の邪魔をしていたようです!

  • layy
  • ベストアンサー率23% (292/1222)
回答No.1

今は集計シートのセルに検索値をいれておいて、残りは引っ張ってくる感じですか?。 簡単なところでは、INPUTBOXの使い方を見て下さい。値入力を促す機能です。 この結果値を使うと良いです。

loveless-05410
質問者

お礼

回答有難うございます。 INPUTBOXですね!やってみます!

関連するQ&A

  • VBAについて質問です。

    VBAについて質問です。 まとまったデータがあるところから検索したい月及び各項目のデータを検索し、項目シート事に抽出するという作業を行なっています。そこで問題がでました。6月にはデータはあるが、5月にはデータはない。 そうすると以下のコードの場合デバックが入り、他の検索が出来ません。 どうしたらよいのでしょうか? 分かる方がいらっしゃいましたらどうかお願い致します。 'シートの変更 Range("B30").Select Sheets("東京").Select '●Sheet2書込み行 Sheets("東京").Range("A5").CurrentRegion.Clear Sheets("東京").Range("A5:F5").Value = _ Array("依頼書No.", "受付日日", "担当者", "枚数", "工数", "備考") Row2 = 5 For R = 2 To Sheets("日報").Cells(Rows.Count, "A").End(xlUp).Row If Sheets("東京").Range("A2") = Sheets("日報").Cells(R, "A") And _ Sheets("東京").Range("B2") = Month(Sheets("日報").Cells(R, "C")) Then Row2 = Row2 + 1 Sheets("東京").Cells(Row2, "A") = Sheets("日報").Cells(R, "B") Sheets("東京").Cells(Row2, "B") = Sheets("日報").Cells(R, "D") Sheets("東京").Cells(Row2, "C") = Sheets("日報").Cells(R, "F") Sheets("東京").Cells(Row2, "D") = Sheets("日報").Cells(R, "I") Sheets("東京").Cells(Row2, "E") = Sheets("日報").Cells(R, "K") Sheets("東京").Cells(Row2, "F") = Sheets("日報").Cells(R, "L") End If Next R '●抽出結果を日付で並べ替え If Row2 = 5 Then MsgBox "該当データなし!" Else Sheets("東京").Range("A5:F" & Row2).Sort _ Key1:=Range("B6"), Order1:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom, SortMethod:=xlPinYin End If Sheets("東京").Select Range("B5:B200").Select Selection.NumberFormatLocal = "yyyy/m/d"     Rows("5:5").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .MergeCells = False End With このあとに式を入れて、罫線を入れてコピーして、というコードが入っています。 どうぞ宜しくお願い致します。

  • 検索でのエラー回避について

    検索でのエラー回避について まとまったデータがあるところから検索したい月及び各項目のデータを検索し、項目シート事に抽出するという作業を行なっています。そこで問題がでました。6月にはデータはあるが、5月にはデータはない。 そうすると以下のコードの場合デバックが入り、次の検索が出来ません。 どうしたらよいのでしょうか? 分かる方がいらっしゃいましたらどうかお願い致します。 'シートの変更 Range("B30").Select Sheets("東京").Select '●Sheet2書込み行 Sheets("東京").Range("A5").CurrentRegion.Clear Sheets("東京").Range("A5:F5").Value = _ Array("依頼書No.", "受付日日", "担当者", "枚数", "工数", "備考") Row2 = 5 For R = 2 To Sheets("日報").Cells(Rows.Count, "A").End(xlUp).Row If Sheets("東京").Range("A2") = Sheets("日報").Cells(R, "A") And _ Sheets("東京").Range("B2") = Month(Sheets("日報").Cells(R, "C")) Then Row2 = Row2 + 1 Sheets("東京").Cells(Row2, "A") = Sheets("日報").Cells(R, "B") Sheets("東京").Cells(Row2, "B") = Sheets("日報").Cells(R, "D") Sheets("東京").Cells(Row2, "C") = Sheets("日報").Cells(R, "F") Sheets("東京").Cells(Row2, "D") = Sheets("日報").Cells(R, "I") Sheets("東京").Cells(Row2, "E") = Sheets("日報").Cells(R, "K") Sheets("東京").Cells(Row2, "F") = Sheets("日報").Cells(R, "L") End If Next R '●抽出結果を日付で並べ替え If Row2 = 5 Then MsgBox "該当データなし!" Else Sheets("東京").Range("A5:F" & Row2).Sort _ Key1:=Range("B6"), Order1:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom, SortMethod:=xlPinYin End If Sheets("東京").Select Range("B5:B200").Select Selection.NumberFormatLocal = "yyyy/m/d"     Rows("5:5").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .MergeCells = False End With このあとに式を入れて、罫線を入れてコピーして、というコードが入っています。 どうぞ宜しくお願い致します。

  • エクセル2000マクロ、チームの合計を別のシートに

    グラウンドゴルフで、1チーム5名、50チームで全員が2ラウンドのゲームのチーム別成績順位表を作ろうとしています。 ”2ラウンド集計”のワークシートに団体戦の個人成績表がありますので、これを元に、”チーム別”ワークシートに各チームだけの成績を抜き出して表示したくて、次のマクロをした結果、添付した画像のようになります。 解決方法を教えていただきたくよろしくお願いいたします。 Sub チーム成績順() ' ' チーム成績順 Macro ' マクロ記録日 : 2013/8/16 ユーザー名 : HAYAO MAEBARA ' 'Dim n Sheets("チーム別").Activate For n = 1 To 50 Cells(n + 4, 2).Value = Sheets("2ラウンド集計").Cells(n * 5 + 5, 2).Value Cells(n + 4, 3).Value = Sheets("2ラウンド集計").Cells(n * 5 + 5, 3).Value Cells(n + 4, 4).Value = Sheets("2ラウンド集計").Cells(n * 5 + 5, 4).Value Cells(n + 4, 6).Value = Sheets("2ラウンド集計").Cells(n * 5 + 5, 6).Value Cells(n + 4, 7).Value = Sheets("2ラウンド集計").Cells(n * 5 + 5, 7).Value Cells(n + 4, 8).Value = Sheets("2ラウンド集計").Cells(n + 9, 8).Value + Cells(n + 10, 8).Value + Cells(n + 11, 8).Value + Cells(n + 12, 8).Value + Cells(n + 13, 8).Value Cells(n + 4, 9).Value = Sheets("2ラウンド集計").Cells(n + 9, 9).Value + Cells(n + 10, 9).Value + Cells(n + 11, 9).Value + Cells(n + 12, 9).Value + Cells(n + 13, 9).Value Cells(n + 4, 10).Value = Sheets("2ラウンド集計").Cells(n + 9, 10).Value + Cells(n + 10, 10).Value + Cells(n + 11, 10).Value + Cells(n + 12, 10).Value + Cells(n + 13, 10).Value Cells(n + 4, 11).Value = Sheets("2ラウンド集計").Cells(n + 9, 11).Value + Cells(n + 10, 11).Value + Cells(n + 11, 11).Value + Cells(n + 12, 11).Value + Cells(n + 13, 11).Value Cells(n + 4, 12).Value = Sheets("2ラウンド集計").Cells(n + 9, 12).Value + Cells(n + 10, 12).Value + Cells(n + 11, 12).Value + Cells(n + 12, 12).Value + Cells(n + 13, 12).Value Cells(n + 4, 13).Value = Sheets("2ラウンド集計").Cells(n + 9, 13).Value + Cells(n + 10, 13).Value + Cells(n + 11, 13).Value + Cells(n + 12, 13).Value + Cells(n + 13, 13).Value Cells(n + 4, 14).Value = Sheets("2ラウンド集計").Cells(n + 9, 14).Value + Cells(n + 10, 14).Value + Cells(n + 11, 14).Value + Cells(n + 12, 14).Value + Cells(n + 13, 14).Value Cells(n + 4, 15).Value = Sheets("2ラウンド集計").Cells(n + 9, 15).Value + Cells(n + 10, 15).Value + Cells(n + 11, 15).Value + Cells(n + 12, 15).Value + Cells(n + 13, 15).Value Cells(n + 4, 16).Value = Cells(n + 4, 8).Value + Cells(n + 4, 12).Value Cells(n + 4, 17).Value = Cells(n + 4, 9).Value + Cells(n + 4, 13).Value Cells(n + 4, 18).Value = Cells(n + 4, 10).Value + Cells(n + 4, 14).Value Cells(n + 4, 19).Value = Cells(n + 4, 11).Value + Cells(n + 4, 15).Value Cells(n + 4, 20).Value = Cells(n + 4, 16).Value * (-3) Cells(n + 4, 21).Value = Cells(n + 4, 19).Value + Cells(n + 9, 20).Value Cells(n + 4, 22).Value = Cells(n + 4, 21).Value / 2 Next n End Sub

  • エクセルVBA全シートに差し込みマクロ構文

    Sheets("震圧データ").Select MsgBox "新規ブックに年月分けて" & vbCrLf & "震圧データを転記します、" & vbCrLf & "お待ちください。" Dim c As Range Dim i As Integer Dim LastRow As Long Dim NewSheetName As String, MatchFlag As Boolean Application.ScreenUpdating = False Workbooks.Add With ThisWorkbook.Sheets("震圧データ") For Each c In .Range(.Cells(4, "A"), .Cells(Rows.Count, "A").End(xlUp)) If NewSheetName <> Year(c.Value2) & "年" & Month(c.Value2) & "月" Then NewSheetName = Year(c.Value2) & "年" & Month(c.Value2) & "月" If c.Row - 2 > Sheets.Count Then Worksheets.Add after:=Worksheets(Worksheets.Count) Else Sheets(c.Row - 2).Select End If ActiveSheet.Name = NewSheetName Sheets(NewSheetName).Range("A1").Value = "年月日" Sheets(NewSheetName).Range("B1").Value = "曜日" Sheets(NewSheetName).Range("C1").Value = "A" Sheets(NewSheetName).Range("D1").Value = "B" Sheets(NewSheetName).Range("E1").Value = "C" Sheets(NewSheetName).Range("F1").Value = "時間" Sheets(NewSheetName).Range("G1").Value = "状態" Sheets(NewSheetName).Range("I1").Value = "No.1" Sheets(NewSheetName).Range("I2").Value = "記録者" Sheets(NewSheetName).Range("I3").Value = "氏名:" Sheets(NewSheetName).Range("I4").Value = "=IF(ISBLANK(A4),"""",DATEDIF("""",Today(),""Y"") & ""歳"")" Sheets(NewSheetName).Range("I5").Value = "=""転載日""" Sheets(NewSheetName).Range("I6").Value = "=TODAY()" Sheets(NewSheetName).Range("I56").Value = "=IF(ISBLANK(A56),"""",""No.2"")" Sheets(NewSheetName).Range("I57").Value = "=IF(ISBLANK(A56),"""",""記録者"")" Sheets(NewSheetName).Range("I58").Value = "=IF(ISBLANK(A56),"""", ""氏名:"")" Sheets(NewSheetName).Range("I59").Value = "=IF(ISBLANK(A56),"""",DATEDIF("""",Today(),""Y"") & ""歳"")" Sheets(NewSheetName).Range("I60").Value = "=IF(ISBLANK(A56),"""",""転載日"")" Sheets(NewSheetName).Range("I61").Value = "=IF(ISBLANK(A56),"""",TODAY())" Sheets(NewSheetName).Range("I111").Value = "=IF(ISBLANK(A111),"""",""No.3"")" Sheets(NewSheetName).Range("I112").Value = "=IF(ISBLANK(A111),"""",""記録者"")" Sheets(NewSheetName).Range("I113").Value = "=IF(ISBLANK(A111),"""", ""氏名:"")" Sheets(NewSheetName).Range("I114").Value = "=IF(ISBLANK(A111),"""",DATEDIF("""",Today(),""Y"") & ""歳"")" Sheets(NewSheetName).Range("I115").Value = "=IF(ISBLANK(A111),"""",""転載日"")" Sheets(NewSheetName).Range("I116").Value = "=IF(ISBLANK(A111),"""",TODAY())" Sheets(NewSheetName).Range("I166").Value = "=IF(ISBLANK(A166),"""",""No.4"")" Sheets(NewSheetName).Range("I167").Value = "=IF(ISBLANK(A166),"""",""記録者"")" Sheets(NewSheetName).Range("I168").Value = "=IF(ISBLANK(A166),"""", ""氏名"")" Sheets(NewSheetName).Range("I169").Value = "=IF(ISBLANK(A166),"""",DATEDIF("""",Today(),""Y"") & ""歳"")" Sheets(NewSheetName).Range("I170").Value = "=IF(ISBLANK(A166),"""",""転載日"")" Sheets(NewSheetName).Range("I171").Value = "=IF(ISBLANK(A166),"""",TODAY())" Sheets(NewSheetName).Range("H1").Value = "提出済○" Sheets(NewSheetName).Range("A57").Select Range("I6,I61,I116").Select Range("I6,I61,I116,I171").Select Selection.NumberFormatLocal = "yyyy/m/d" Columns("F:F").Select Selection.NumberFormatLocal = "[$-409]h:mm AM/PM;@" Range("G1").Select With Selection .HorizontalAlignment = xlCenter End With LastRow = Sheets(NewSheetName).Cells(Rows.Count, "A").End(xlUp).Row Sheets(NewSheetName).Cells(LastRow + 1, "A").Resize(1, 8).Value = .Cells(c.Row, "A").Resize(1, 8).Value Sheets(NewSheetName).Columns("A:I").EntireColumn.AutoFit Next 新規ブック最終シートのみ適用できますが他の月別シートに適用できておりません '↓どのような構文にしたら適用されるのでしょうか?ここからが質問です↓ If Sheets(NewSheetName).Range("A56") = "" Then Range("I56:I171").Delete Else Sheets(NewSheetName).Range("A56").Value = "年月日" Sheets(NewSheetName).Range("B56").Value = "曜日" Sheets(NewSheetName).Range("C56").Value = "A" Sheets(NewSheetName).Range("D56").Value = "B" Sheets(NewSheetName).Range("E56").Value = "C" Sheets(NewSheetName).Range("F56").Value = "時間" Sheets(NewSheetName).Range("G56").Value = "状態" End If 'ここまで! どなたかご教示お願いします .Activate End With

  • QNo.2826776の質問の続き 表から別シートに一覧表を作成したいのですが

    質問の続きになってしまうのですが sheet1からsheet2へ転記するVBA Private Sub Worksheet_Change(ByVal Target As Range) Sheets("Sheet2").Cells.ClearContents Sheets("Sheet2").Cells(1, 1).Value = "日付" Sheets("Sheet2").Cells(1, 2).Value = "応援に行く人" Sheets("Sheet2").Cells(1, 3).Value = "応援をもらう店舗" r2 = 1 For r = 2 To Range("A65536").End(xlUp).Row For c = 2 To 256 If Cells(r, c) <> "" Then r2 = r2 + 1 Sheets("Sheet2").Cells(r2, 1).Value = Sheets("Sheet1").Cells(r, 1) Sheets("Sheet2").Cells(r2, 2).Value = Sheets("Sheet1").Cells(1, c) Sheets("Sheet2").Cells(r2, 3).Value = Sheets("Sheet1").Cells(r, c) End If Next c Next r End Sub と教えていただきました。 もうひとつ条件を入れたいのですが「"休"を無視する」 座標やシート名の入れ替えは理解できたのですが、やはり難しく ここを頼ってしまいました。教えてください。よろしくお願いします。

  • 指定記号のみ別シートにコピー

    sheet1(表-1)の入力文字「A,C,E」をsheet2へコピーする。 sheet2(表-3)のように[A,C,E」以外及びsheet1空白のセルはsheet2でも空白としたい。 その際、sheet2(表-2)に入力済みの記号「○、●、◎」はそのまま残したい。 下記のコードでは、sheet2に入力済みの記号「○、●、◎」が消えてしまいます。 どなたかコードがわかる方よろしくお願いします。 Sub シートコピー() Dim r As Range For Each r In Worksheets("Sheet1").Range("B1:D5") If WorksheetFunction.CountIf(Range("A8:A10"), r.Value) Then Sheets("sheet2").Range(r.Address).Value = r.Value Else Sheets("sheet2").Range(r.Address).Value = "" End If Next End Sub セルA11に"0"を入力して実行してもsheet1空白セルはsheet2でも空白となり困っています。

  • エクセルVBAについて

    こんにちわ! 今、エクセルでAシートの入力した項目をBのシートへデーターが入力できるようなシステムを以下のようにくみました。 そこでBシートにデーターが入力されるのですが20行まで入力すると入力できないようにしたいのですが、なかなか上手くいきません。 A1からF20まで書式のロックを外しそれ以外のセルは保護をかけたのですがその状態でVBAを使って20行以上入力できませんという感じのエラー表示をしたいのですが、どうすればいいでしょうか? VBAは初心者ですが宜しくお願いします。 Private Sub CommandButton1_Click() Dim row As Integer row = WorksheetFunction.CountA(Sheets("date").Columns(1)) + 1 Sheets("date").Cells(row, 1).Value = Range("B2").Value row = WorksheetFunction.CountA(Sheets("date").Columns(2)) + 1 Sheets("date").Cells(row, 2).Value = Range("B3").Value row = WorksheetFunction.CountA(Sheets("date").Columns(3)) + 1 Sheets("date").Cells(row, 3).Value = Range("B4").Value row = WorksheetFunction.CountA(Sheets("date").Columns(4)) + 1 Sheets("date").Cells(row, 4).Value = Range("B5").Value row = WorksheetFunction.CountA(Sheets("date").Columns(5)) + 1 Sheets("date").Cells(row, 5).Value = Range("B6").Value row = WorksheetFunction.CountA(Sheets("date").Columns(6)) + 1 Sheets("date").Cells(row, 6).Value = Range("B7").Value Sheets("統制入力").Select Range("B17").Select ActiveWindow.SmallScroll Down:=-9 Range("B3:B7").Select Selection.ClearContents Range("B1").Select End Sub

  • エクセル マクロ 抽出

    教えてください。 ○と記入されたセルを参照して、一つ上のセル・A列にある同じ行のセル・ 9行目にある同じ列のセルを抽出しようとしています。 下記の通り入力すると 行数=値.Rowでエラーが出たしまいました。 試行錯誤頑張りましたが解決できそうにありませんのでお力を貸して頂けないでしょうか。 Sub 抽出() Dim i, 行数, 列数 As Long Dim 値 As Range i = 0 行数 = 値.Row 列数 = 値.Column For Each 値 In Sheets("sheet1").Range("C12:R171") If 値.Value = "○" Then i = i + 1 With Sheets("sheet2") .Cells(i, 3).Value = Sheets("sheet1").Cells(行数, 1).Value .Cells(i, 4).Value = Sheets("sheet1").Cells(9, 列数).Value .Cells(i, 5).Value = 値.Offset(-1, 0).Value End With End If Next End Sub

  • VBAについて教えて下さい

    EXCEL2010を使用中。 独学で、Web上で色々検索したものをパクリながら VBAを組んでるようなレベルです。 今回教えて頂きたい内容ですが、 カード型の入力シート「Sheet名:入力」を作成して、 登録ボタンでデータベースシート「Sheet名:スケジュール」に 書き足していくような業務スケジュール表を作成中です。 わざわざそんな手のこんだものを 作らなくてもと思われるかもしれませんが 諸事情があっての事なので 登録ボタンのVBAは Private Sub 登録_Click() Dim row As Integer row = WorksheetFunction.CountA(Sheets("スケジュール").Columns(1)) + 1 Sheets("スケジュール").Cells(row, 1).Value = Range("Q2").Value Sheets("スケジュール").Cells(row, 2).Value = Range("G6:G7").Value Sheets("スケジュール").Cells(row, 3).Value = Range("G8:G9").Value Sheets("スケジュール").Cells(row, 4).Value = Range("G10:G11").Value Sheets("スケジュール").Cells(row, 5).Value = Range("G12:G13").Value Sheets("スケジュール").Cells(row, 6).Value = Range("G14:G15").Value Sheets("スケジュール").Cells(row, 7).Value = Range("G16:G17").Value Sheets("スケジュール").Cells(row, 8).Value = Range("G18:G19").Value Sheets("スケジュール").Cells(row, 9).Value = Range("G20:G21").Value Sheets("スケジュール").Cells(row, 10).Value = Range("G22:G23").Value Sheets("スケジュール").Cells(row, 11).Value = Range("G24:G25").Value Sheets("スケジュール").Cells(row, 12).Value = Range("M6:M7").Value Sheets("スケジュール").Cells(row, 13).Value = Range("M8:M9").Value Sheets("スケジュール").Cells(row, 14).Value = Range("M10:M11").Value Sheets("スケジュール").Cells(row, 15).Value = Range("M12:M13").Value Sheets("スケジュール").Cells(row, 16).Value = Range("M14:M15").Value Sheets("スケジュール").Cells(row, 17).Value = Range("M16:M17").Value Sheets("スケジュール").Cells(row, 18).Value = Range("M18:M19").Value Sheets("スケジュール").Cells(row, 19).Value = Range("M20:M21").Value Sheets("スケジュール").Cells(row, 20).Value = Range("M22:M23").Value Sheets("スケジュール").Cells(row, 21).Value = Range("M24:M25").Value Sheets("スケジュール").Cells(row, 22).Value = Range("S6:S7").Value Sheets("スケジュール").Cells(row, 23).Value = Range("S8:S9").Value Sheets("スケジュール").Cells(row, 24).Value = Range("S10:S11").Value Sheets("スケジュール").Cells(row, 25).Value = Range("S12:S13").Value Sheets("スケジュール").Cells(row, 26).Value = Range("S14:S15").Value Sheets("スケジュール").Cells(row, 27).Value = Range("S16:S17").Value Sheets("スケジュール").Cells(row, 28).Value = Range("S18:S19").Value Sheets("スケジュール").Cells(row, 29).Value = Range("S20:S21").Value Sheets("スケジュール").Cells(row, 30).Value = Range("S22:S23").Value Sheets("スケジュール").Cells(row, 31).Value = Range("S24:S25").Value Sheets("スケジュール").Cells(row, 32).Value = Range("S26:S27").Value Range("Q1").Select End Sub としています。 この時、移行するセル内の文字数が指定文字数を超えると、 移行した先のセルの書式設定を「折り返して全体を表示する」に 設定変更をしたいですのですが、その方法について ご教授いただけないでしょうか? 因みに現在の設定は、「縮小して全体を表示する」としています。

  • エクセル2003マクロの再編集

    Sub test() Dim 行1 As Long, 最終行 As Long, 行2 As Long Sheets("Sheet2").Cells.ClearContents Sheets("Sheet1").Activate 最終行 = Range("C65536").End(xlUp).Row 行2 = 1 For 行1 = 1 To 最終行 Sheets("Sheet2").Cells(行2, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Cells(行2, 3).Value = Abs(Sheets("Sheet2").Cells(行2, 3).Value) If Range("A" & 行1).Value = "BBBB1" Then Sheets("Sheet2").Range("A" & 行2) = Range("A" & 行1) & "-1" Sheets("Sheet2").Cells(行2 + 1, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Range("A" & 行2 + 1) = Range("A" & 行1) & "-2" 行2 = 行2 + 1 End If If Range("A" & 行1) = "" Then 行2 = 行2 - 1 Sheets("Sheet2").Range("C" & 行2) = Sheets("Sheet2").Range("C" & 行2) + Range("C" & 行1) End If 行2 = 行2 + 1 Next 行1 End Sub を編集したいのですが全然図りません ご指導お願いします 元データ AAAA5 9601  950 BBBB1 9660  150 ASAS9 9654  -50 AXCW5 9603  1375 以下の用にマクロで変換する用に出来たのですが 【1】 BBBB1だけではなくAAAA5も対処になったときの 追加方法です 元データは一切変更が出来ません ※フォントの変更も不可です 【2】 元データと変換後データがSheet1からSheet2になっていますが Sheet1の元は範囲はA1~C400で変換後をSheet1E1~G400にしたいのです AAAA5 9601  950  BBBB1-1 9660  150  BBBB1-2 9660  150 ASAS9 9654  50 AXCW5 9603  1375

専門家に質問してみよう