パソコン仕事5倍塾
35,000人を指導した東大卒・元日本IBM社内講師が直伝
MENU
マメコトさんの投稿
(投稿ID: 4128) 添付ファイルのダウンロード権限がありません
小川 慶一さんのコメント
(コメントID: 5683)
Option Explicit 'Module2は提出時には削除しましょう。 Sub Denpyou() Call Sort_First Call Delete_Sheets Call Create_Denpyou Call Sort_End End Sub Private Sub Sort_First() Dim Ws As Worksheet Dim nGyou As Long Dim nGyouMx As Long Set Ws = Worksheets("main") Ws.Range("A1").Value = "No" nGyouMx = Ws.Range("B" & Rows.Count).End(xlUp).Row 'Autofillを使うことも検討してみてください。 For nGyou = 2 To nGyouMx Ws.Range("A" & nGyou).Value = nGyou - 1 Next '↓もうちょいwithでまとめられそう。たとえば、少なくとも[*1]以下はすべて with ws の中に入れられますね。 Ws.Activate Ws.Sort.SortFields.Clear '[*1] Ws.Sort.SortFields.Add _ Key:=Range("B2:B" & nGyouMx), _ SortOn:=xlSortOnValues, _ Order:=xlAscending, _ DataOption:=xlSortNormal With Ws.Sort .SetRange Range("A1:G" & nGyouMx) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub Private Sub Delete_Sheets() Dim Ws As Worksheet Application.DisplayAlerts = False For Each Ws In Worksheets If Left(Ws.Name, 4) <> "main" Then Ws.Delete End If Next Application.DisplayAlerts = True End Sub Private Sub Create_Denpyou() Dim nGyouFm As Long Dim nGyouTo As Long Dim nGyouFmMx As Long Dim nWs As Long Dim WsFm As Worksheet Dim WsTo As Worksheet Dim strDate As String Dim strTori As String nWs = Worksheets.Count Set WsFm = Worksheets("main") nGyouFmMx = WsFm.Range("B" & Rows.Count).End(xlUp).Row '[*2], [*3]は重複している部分が多いですね。見本と比べて要再検討です。 'あるいは、このメールセミナーの第1回から順番にやりなおしてプロセスを体験するのもよいかと。 For nGyouFm = 2 To nGyouFmMx strTori = WsFm.Range("B" & nGyouFm).Value strDate = WsFm.Range("C" & nGyouFm).Value If strTori <> WsFm.Range("B" & nGyouFm - 1) Then Worksheets("main1").Copy after:=Worksheets(nWs) Worksheets(nWs + 1).Name = strTori nWs = nWs + 1 Set WsTo = Worksheets(strTori) '[*2] WsTo.Range("B16").Value = Format(strDate, "yy") '日付(年) WsTo.Range("C16").Value = Format(strDate, "mm") '日付(月) WsTo.Range("D16").Value = Format(strDate, "dd") '日付(日) WsTo.Range("E16").Value = WsFm.Range("D" & nGyouFm).Value '会計番号 WsTo.Range("F16").Value = WsFm.Range("E" & nGyouFm).Value '伝票番号 WsTo.Range("H16").Value = WsFm.Range("F" & nGyouFm).Value '摘要 If WsFm.Range("G" & nGyouFm).Value > 0 Then WsTo.Range("I16").Value = WsFm.Range("G" & nGyouFm).Value '借方金額 Else WsTo.Range("J16").Value = WsFm.Range("G" & nGyouFm).Value * (-1) '貸方金額 End If WsTo.Range("K16").Value = WsTo.Range("I16").Value - WsTo.Range("J16").Value '残高 nGyouTo = 17 If strTori <> WsFm.Range("B" & nGyouFm + 1).Value Then Call Add_Keisen End If Else '[*3] WsTo.Range("B" & nGyouTo).Value = Format(strDate, "yy") '日付(年) WsTo.Range("C" & nGyouTo).Value = Format(strDate, "mm") '日付(月) WsTo.Range("D" & nGyouTo).Value = Format(strDate, "dd") '日付(日) WsTo.Range("E" & nGyouTo).Value = WsFm.Range("D" & nGyouFm).Value '会計番号 WsTo.Range("F" & nGyouTo).Value = WsFm.Range("E" & nGyouFm).Value '伝票番号 WsTo.Range("H" & nGyouTo).Value = WsFm.Range("F" & nGyouFm).Value '摘要 If WsFm.Range("G" & nGyouFm).Value > 0 Then WsTo.Range("I" & nGyouTo).Value = WsFm.Range("G" & nGyouFm).Value '借方金額 Else WsTo.Range("J" & nGyouTo).Value = WsFm.Range("G" & nGyouFm).Value * (-1) '貸方金額 End If WsTo.Range("K" & nGyouTo).Value = WsTo.Range("K" & nGyouTo - 1).Value _ + WsTo.Range("I" & nGyouTo).Value _ - WsTo.Range("J" & nGyouTo).Value '残高 nGyouTo = nGyouTo + 1 If strTori <> WsFm.Range("B" & nGyouFm + 1).Value Then Call Add_Keisen End If End If Next End Sub Private Sub Add_Keisen() Dim Gyou As Long 'selection の書き直しについては第1回-第9回までをやりなおす過程で学んでください Gyou = Range("E" & Rows.Count).End(xlUp).Row Range("B16:K" & Gyou).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Range("A1").Select End Sub Private Sub Sort_End() Dim Ws As Worksheet Dim nGyouMx As Long Set Ws = Worksheets("main") nGyouMx = Ws.Range("B" & Rows.Count).End(xlUp).Row Ws.Activate Ws.Sort.SortFields.Clear Ws.Sort.SortFields.Add _ Key:=Range("A2:A" & nGyouMx), _ SortOn:=xlSortOnValues, _ Order:=xlAscending, _ DataOption:=xlSortNormal With Ws.Sort .SetRange Range("A1:G" & nGyouMx) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Ws.Range("A1:A" & nGyouMx).ClearContents End Sub
Captcha:
たった1ヶ月で人生が劇的に変わりました
佐藤信さん
役員クラスの方から高い評価を受けるようになりました。
佐賀県 - 岩本徹さん
今までまったく知らなかったショートカットキーを使いまくっています。
東京都 - 鷹觜慶さん
年齢60才間近、営業で外回りの時間が多い私でも退社時間が1-2時間程度早くなりました。
東京都 - 宗内隆明さん
受講前もすでにパソコン得意でしたが、そんな私でも受講して本当に良かったと思えた講座です。
東京都 - 佐伯とも子さん
ここまで包括的に仕事に役立つ深い学びを受けれた講座は初めてでした
東京都 - 飯田倫子さん
2025年06月12日 15:17
2025年06月10日 08:38
2025年06月02日 06:28
2025年06月01日 18:17
2025年05月23日 13:22
2025年06月12日 15:34
2025年06月10日 14:40
2025年06月02日 21:49
2022年02月24日 10:59
表示できる投稿はありません。
この学習サイトの教材制作、サポート、システム開発をすべてやっています。
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
2025年06月23日 20:45
2025年06月16日 15:45
2025年06月13日 13:15
2025年06月12日 18:00
2025年04月15日 11:30
2025年06月02日 22:50
2025年05月14日 11:55
2025年02月04日 08:51
2025年02月03日 12:58
2024年11月27日 11:48
2025年03月26日 22:33
2025年03月26日 22:12
2025年03月24日 22:28
2025年03月19日 20:10
2025年03月18日 20:52
2025年04月16日 08:30
2025年03月18日 09:07
2025年03月18日 09:06
2025年03月15日 13:23
2025年02月26日 16:37
2025年04月02日 21:01
2025年04月02日 20:47
2025年04月02日 20:37
2025年04月01日 22:03
2025年04月01日 21:27
2025年04月16日 08:32
2025年03月18日 09:10
2025年03月18日 09:09
マメコトさんの投稿
(投稿ID: 4128) 添付ファイルのダウンロード権限がありません
「とりあえず動く」ものなので、マクロが記録したコードをそのまま使ったりしています。
いかがでしょうか。
小川 慶一さんのコメント
(コメントID: 5683)
添削を返送します。
添付ファイルは無事に受領できていました。
> 先生のように30分では書けませんでしたが、1時間はかからずに書けました。(ボタンは作りませんでしたけど。)
> 「とりあえず動く」ものなので、マクロが記録したコードをそのまま使ったりしています。
> いかがでしょうか。