パソコン仕事5倍塾
35,000人を指導した東大卒・元日本IBM社内講師が直伝
MENU
受講生さんの投稿
(投稿ID: 2680)
Sub denpyoMake() 'mainシートの取引先名称ごとにシートを分ける Dim shFm As Worksheet Dim shTo As Worksheet Dim sortMaeNum As Long Dim sortMaeNumMx Dim lnfm As Long Dim lnfmMx As Long Dim lnTo As Long Dim dt As Date Set shFm = Worksheets("main") 'main、main1以外のシートを削除 deleteSheet sortMaeNumMx = Range("B" & Rows.Count).End(xlUp).Row For sortMaeNum = 2 To sortMaeNumMx shFm.Range("A" & sortMaeNum).Value = sortMaeNum - 1 Next sortMaeNum 'mainシートでソートする sortTorihiki lnfmMx = Range("B" & Rows.Count).End(xlUp).Row For lnfm = 2 To lnfmMx If shFm.Range("B" & lnfm).Value <> shFm.Range("B" & lnfm - 1).Value Then If lnfm <> 2 Then '罫線を引く keisenDraw (lnTo) '印刷範囲を設定する printSetting (lnTo) End If Worksheets("main1").Copy after:=Worksheets(Worksheets.Count) ActiveSheet.Name = shFm.Range("B" & lnfm).Value Set shTo = ActiveSheet shTo.Range("F2").Value = shTo.Name lnTo = 16 Else lnTo = lnTo + 1 End If dt = shFm.Range("C" & lnfm).Value shTo.Range("B" & lnTo).Value = Right(Year(dt), 2) shTo.Range("C" & lnTo).Value = Month(dt) shTo.Range("D" & lnTo).Value = Day(dt) shTo.Range("E" & lnTo).Value = shFm.Range("D" & lnfm).Value shTo.Range("F" & lnTo).Value = shFm.Range("E" & lnfm).Value shTo.Range("H" & lnTo).Value = shFm.Range("F" & lnfm).Value If shFm.Range("G" & lnfm).Value > 0 Then shTo.Range("I" & lnTo).Value = shFm.Range("G" & lnfm).Value Else shTo.Range("J" & lnTo).Value = shFm.Range("G" & lnfm).Value End If shTo.Range("K" & lnTo).Value = shTo.Range("K" & lnTo - 1).Value + shFm.Range("G" & lnfm).Value Next lnfm 'mainシートを元の順番でソートする sortMotojun shFm.Activate shFm.Range("A1").Select End Sub Private Sub sortTorihiki() '取引先名称で並び替える Columns("A:G").Select With Worksheets("main").Sort .SortFields.Clear .SortFields.Add Key:=Range("B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range("C:C"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range("D:D"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range("E:E"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range("F:F"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("A:G") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Worksheets("main").Range("A1").Value = "No" End Sub Private Sub sortMotojun() '元の並び順に並び替える Columns("A:G").Select With Worksheets("main").Sort .SortFields.Clear .SortFields.Add Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("A:G") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("A:A").ClearContents End Sub Private Sub deleteSheet() ' main、main1以外のシートを削除する Application.DisplayAlerts = False Dim sh As Worksheet For Each sh In Worksheets If Left(sh.Name, 4) <> "main" Then sh.Delete End If Next Application.DisplayAlerts = True End Sub Private Sub keisenDraw(mxGyo As Long) '追加シートに罫線を引く With Range("B16:K" & mxGyo) .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With End With End Sub Private Sub printSetting(maxGyo As Long) '印刷範囲を変更する。またヘッダ・フッタを入れる。 Range("A1:L" & maxGyo).Select ActiveSheet.PageSetup.PrintArea = "A1:L" & maxGyo + 1 Application.PrintCommunication = False With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" .LeftHeader = "" .CenterHeader = "" .RightHeader = "&D" .LeftFooter = "" .CenterFooter = "" .RightFooter = "&A" .LeftMargin = Application.InchesToPoints(0.78740157480315) .RightMargin = Application.InchesToPoints(0.78740157480315) .TopMargin = Application.InchesToPoints(0.984251968503937) .BottomMargin = Application.InchesToPoints(0.984251968503937) .HeaderMargin = Application.InchesToPoints(0.511811023622047) .FooterMargin = Application.InchesToPoints(0.511811023622047) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .CenterHorizontally = True .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .FitToPagesWide = 10 .FitToPagesTall = 10 .PrintErrors = xlPrintErrorsDisplayed .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = False .EvenPage.LeftHeader.Text = "" .EvenPage.CenterHeader.Text = "" .EvenPage.RightHeader.Text = "" .EvenPage.LeftFooter.Text = "" .EvenPage.CenterFooter.Text = "" .EvenPage.RightFooter.Text = "" .FirstPage.LeftHeader.Text = "" .FirstPage.CenterHeader.Text = "" .FirstPage.RightHeader.Text = "" .FirstPage.LeftFooter.Text = "" .FirstPage.CenterFooter.Text = "" .FirstPage.RightFooter.Text = "" End With Application.PrintCommunication = True End Sub
ゲストさんのコメント
(コメントID: 4137)
'全体に、コメントのタイミングと内容、適切と感じます。 v(^^ ogawa '一方、細かいところでもう一歩踏み込みたいものもあります。 Sub denpyoMake() 'mainシートの取引先名称ごとにシートを分ける Dim shFm As Worksheet Dim shTo As Worksheet Dim sortMaeNum As Long Dim sortMaeNumMx 'データ型抜けてます ogawa Dim lnfm As Long Dim lnfmMx As Long Dim lnTo As Long Dim dt As Date Set shFm = Worksheets("main") 'main、main1以外のシートを削除 deleteSheet '↓autofilterで番号を入れる方法も調査してみてください ogawa sortMaeNumMx = Range("B" & Rows.Count).End(xlUp).Row For sortMaeNum = 2 To sortMaeNumMx shFm.Range("A" & sortMaeNum).Value = sortMaeNum - 1 Next sortMaeNum 'mainシートでソートする sortTorihiki '変数名も sort という小文字ではじまりますね。。「ハンガリアン記法」について復習を! lnfmMx = Range("B" & Rows.Count).End(xlUp).Row For lnfm = 2 To lnfmMx If shFm.Range("B" & lnfm).Value <> shFm.Range("B" & lnfm - 1).Value Then If lnfm <> 2 Then '罫線を引く keisenDraw (lnTo) '印刷範囲を設定する printSetting (lnTo) End If Worksheets("main1").Copy after:=Worksheets(Worksheets.Count) ActiveSheet.Name = shFm.Range("B" & lnfm).Value Set shTo = ActiveSheet shTo.Range("F2").Value = shTo.Name lnTo = 16 Else lnTo = lnTo + 1 End If dt = shFm.Range("C" & lnfm).Value '↓format関数の活用も研究してください。ogawa shTo.Range("B" & lnTo).Value = Right(Year(dt), 2) shTo.Range("C" & lnTo).Value = Month(dt) shTo.Range("D" & lnTo).Value = Day(dt) shTo.Range("E" & lnTo).Value = shFm.Range("D" & lnfm).Value shTo.Range("F" & lnTo).Value = shFm.Range("E" & lnfm).Value shTo.Range("H" & lnTo).Value = shFm.Range("F" & lnfm).Value If shFm.Range("G" & lnfm).Value > 0 Then shTo.Range("I" & lnTo).Value = shFm.Range("G" & lnfm).Value Else shTo.Range("J" & lnTo).Value = shFm.Range("G" & lnfm).Value End If shTo.Range("K" & lnTo).Value = shTo.Range("K" & lnTo - 1).Value + shFm.Range("G" & lnfm).Value Next lnfm 'mainシートを元の順番でソートする sortMotojun '↑最後のシートだけ、ヘッダーとフッターの記載が抜けています。 ogawa shFm.Activate shFm.Range("A1").Select End Sub Private Sub sortTorihiki() '取引先名称で並び替える '以下だいたいよいですが、僕なら先にNoという文字列をセルA1に入れるかな。それまでは、並べ替えする表の見出しがない状態なわけですから。 ogawa Columns("A:G").Select With Worksheets("main").Sort .SortFields.Clear .SortFields.Add Key:=Range("B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range("C:C"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range("D:D"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range("E:E"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range("F:F"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("A:G") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Worksheets("main").Range("A1").Value = "No" End Sub Private Sub sortMotojun() '元の並び順に並び替える '↓どのシートの?そこを指定しないと Activesheet で選択されてしまいます。 Columns("A:G").Select With Worksheets("main").Sort .SortFields.Clear .SortFields.Add Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("A:G") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With '↓どのシートの?そこを指定しないと Activesheet で実行されてしまいます。(2016以降ではなぜかこれでも結果的に目論見どおりに動くが) Range("A:A").ClearContents End Sub Private Sub deleteSheet() ' main、main1以外のシートを削除する Application.DisplayAlerts = False Dim sh As Worksheet For Each sh In Worksheets If Left(sh.Name, 4) <> "main" Then sh.Delete End If Next Application.DisplayAlerts = True End Sub Private Sub keisenDraw(mxGyo As Long) '追加シートに罫線を引く With Range("B16:K" & mxGyo) .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With End With End Sub Private Sub printSetting(maxGyo As Long) '印刷範囲を変更する。またヘッダ・フッタを入れる。 '↓インデント不正。そもそも .select の行は不要です。 Range("A1:L" & maxGyo).Select '以下、不必要なものは削ってください。 ActiveSheet.PageSetup.PrintArea = "A1:L" & maxGyo + 1 Application.PrintCommunication = False With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" .LeftHeader = "" .CenterHeader = "" .RightHeader = "&D" .LeftFooter = "" .CenterFooter = "" .RightFooter = "&A" .LeftMargin = Application.InchesToPoints(0.78740157480315) .RightMargin = Application.InchesToPoints(0.78740157480315) .TopMargin = Application.InchesToPoints(0.984251968503937) .BottomMargin = Application.InchesToPoints(0.984251968503937) .HeaderMargin = Application.InchesToPoints(0.511811023622047) .FooterMargin = Application.InchesToPoints(0.511811023622047) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .CenterHorizontally = True .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .FitToPagesWide = 10 .FitToPagesTall = 10 .PrintErrors = xlPrintErrorsDisplayed .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = False .EvenPage.LeftHeader.Text = "" .EvenPage.CenterHeader.Text = "" .EvenPage.RightHeader.Text = "" .EvenPage.LeftFooter.Text = "" .EvenPage.CenterFooter.Text = "" .EvenPage.RightFooter.Text = "" .FirstPage.LeftHeader.Text = "" .FirstPage.CenterHeader.Text = "" .FirstPage.RightHeader.Text = "" .FirstPage.LeftFooter.Text = "" .FirstPage.CenterFooter.Text = "" .FirstPage.RightFooter.Text = "" End With Application.PrintCommunication = True End Sub
外部アカウントで登録
たった1ヶ月で人生が劇的に変わりました
佐藤信さん
役員クラスの方から高い評価を受けるようになりました。
佐賀県 - 岩本徹さん
今までまったく知らなかったショートカットキーを使いまくっています。
東京都 - 鷹觜慶さん
年齢60才間近、営業で外回りの時間が多い私でも退社時間が1-2時間程度早くなりました。
東京都 - 宗内隆明さん
受講前もすでにパソコン得意でしたが、そんな私でも受講して本当に良かったと思えた講座です。
東京都 - 佐伯とも子さん
ここまで包括的に仕事に役立つ深い学びを受けれた講座は初めてでした
東京都 - 飯田倫子さん
2024年04月27日 15:36
2024年04月25日 07:00
2024年04月23日 21:36
2024年04月23日 10:01
2024年04月22日 03:23
2024年04月28日 20:53
2024年04月28日 19:20
2024年04月28日 15:34
2024年04月28日 12:07
2024年04月28日 11:43
2022年02月24日 10:59
2019年12月23日 05:57
2019年09月20日 12:29
表示できる投稿はありません。
この学習サイトの教材制作、サポート、システム開発をすべてやっています。
2022年02月02日 00:00
2022年02月02日 03:00
2022年02月02日 06:00
2022年02月02日 09:00
2022年02月02日 12:00
2024年02月15日 18:30
2024年02月09日 17:05
2024年01月19日 13:00
2023年12月31日 17:00
2023年12月21日 14:00
2024年04月27日 23:02
2024年02月28日 14:53
2024年02月27日 14:27
2024年02月27日 14:21
2024年02月27日 14:15
受講生さんの投稿
(投稿ID: 2680)
お世話になっております。
10月末から勉強させていただいております。
複数シート間で処理をするときのプログラムの書き方がまだしっかりと身についていません。
また変数名を何にするか決めるのに時間がかかり決めた変数名に自信が持てません。
引き続き身につくよう勉強していきます。
読みにくいコードとなり申し訳ありませんがご確認お願いいたします。
ゲストさんのコメント
(コメントID: 4137)
この演習は、以下の動画解説どおりにひとつづつ自力で問題を解けるようになるまでくり返すのがいちばん力つきますよ。
https://online.pc5bai.com/movie/index/26
>また変数名を何にするか決めるのに時間がかかり決めた変数名に自信が持てません。
「ハンガリアン記法」で行きましょう。
第1章の復習お願いします。
以下、まだ直そうと思えば直せるところもありますが、まずは添削です。