[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロを組むにあたって』（あああ）
いつも大変お世話になっております。
残業表から、出勤簿へデータの移行を行うためのマクロを組みたいのですが
無駄が多くなっているような気がしてなりません。
今後の勉強の為にも、ヒント、アドバイス、ご回答をお願いいたします。
・ボタンをクリックするとマクロを起動
・出勤簿という別ブックを開く
・マクロブックA列3行目以降に記載されている氏名と出勤簿ブックのシート名が一致した場合その行をコピーし行列を入れ替えてペースト
・A列が空白になるまで繰り返す。
・完了したら保存して出勤簿ブックを閉じる
分かりにくいかと思いますが、この内容のマクロが組みたいです。
ご回答よろしくお願いいたします。
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
>残業表から、出勤簿へデータの移行を行うためのマクロを組みたいのですが >無駄が多くなっているような気がしてなりません。
と書かれてるということは、現状のコードがあると思うので、現状のコードをアップ してみてはいかがでしょう？ （通りすがり） 2021/06/02(水) 15:03
ここでアドバイスをもらっている内容に留意して作成すると、きっと良くなると思います。
（さんぷる） 2021/06/02(水) 15:36
コード全文になります。
作成しながらテストを繰り返していたらこのような長文になってしまいました。
何が余分でどこが足りないのかがよくわかっていません。
sub test()
Dim cl As Range
Dim wb As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim i As Integer
'On Error Resume Next
Workbooks.Open Filename:="C:\Users\PC603\Desktop\出勤簿.xlsm"
Windows.Arrange ArrangeStyle:=xlArrangeStyleVertical
Set wb = Workbooks("出勤簿.xlsm")
Set wb2 = Workbooks("労務 残業表(テスト）.xlsm")
Set cl = wb2.ActiveSheet.Range("A3:A90")
Worksheets("氏名").Select
For i = 1 To Worksheets.Count
Set ws = wb.Worksheets(i)
For Each ws In wb.Worksheets
If ws.Name <> "設定" Then
For Each cl In wb2.ActiveSheet.Range("A3:A30")
If ActiveSheet.Name = cl Then
wb2.Activate
cl.Select
wb2.ActiveSheet.Range(Cells(cl.Row, 3), Cells(cl.Row, 33)).Select
Selection.Copy
wb.Activate
If ws.Cells(2, 2) = "" Then
ws.Cells(2, 2).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Selection.Interior.ColorIndex = xlNone
Application.CutCopyMode = False
ElseIf ws.Cells(2, 2) <> "" Then
ws.Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Selection.Interior.ColorIndex = xlNone
Application.CutCopyMode = False
End If
ElseIf ws.Name <> cl Then
If ActiveSheet.Name = Sheets(Sheets.Count).Name Then
Worksheets("設定").Select
ActiveWorkbook.Close SaveChanges:=True
End
ElseIf ActiveSheet.Name <> Sheets(Sheets.Count).Name Then
ActiveSheet.Next.Activate
If ActiveSheet.Name = cl Then
wb2.Activate
cl.Select
wb2.ActiveSheet.Range(Cells(cl.Row, 3), Cells(cl.Row, 33)).Select
Selection.Copy
wb.Activate
If ActiveSheet.Name = cl Then
If ActiveSheet.Cells(2, 2) = "" Then
ActiveSheet.Cells(2, 2).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Selection.Interior.ColorIndex = xlNone
Application.CutCopyMode = False
ElseIf ActiveSheet.Cells(2, 2) <> "" Then
ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Selection.Interior.ColorIndex = xlNone
Application.CutCopyMode = False
End If
End If
End If
End If
ElseIf ActiveSheet.Name = Sheets(Sheets.Count).Name Then
Worksheets("設定").Select
ActiveWorkbook.Close SaveChanges:=True
End
ElseIf cl = "" Then
Exit For
End If
Next
End If
Next
Next
End Sub
ご迷惑をおかけします。
（あああ） 2021/06/02(水) 15:48
マクロブックとは何ですか？（関連ブックは３つあるんですか？）
設定シートは、何の処理に関係するんですか？
（半平太） 2021/06/02(水) 17:28
説明がわかりずらく申し訳ございません。
関連ブックは、残業表(マクロを起動させるブック)と出勤簿(データを転記するブック)の2つになります。
設定シートはコードを書く際に分かりやすくするために使用しているだけなので特に意味はありません。
（あああ） 2021/06/02(水) 18:20
こうかな？ ※検証はしておりません m(__)m
Sub test()
Dim rEmpNames As Range
Dim WB出勤簿 As Workbook
Dim WB労務 As Workbook
Dim aCell As Range
Workbooks.Open Filename:="C:\Users\PC603\Desktop\出勤簿.xlsm"
Windows.Arrange ArrangeStyle:=xlArrangeStyleVertical
Set WB出勤簿 = Workbooks("出勤簿.xlsm")
Set WB労務 = Workbooks("労務 残業表(テスト）.xlsm")
Set rEmpNames = WB労務.ActiveSheet.Range("A3:A30")
For Each aCell In rEmpNames
If aCell = "" Then
Exit For
Else
aCell.Offset(, 2).Resize(31).Copy
With WB出勤簿.Sheets(aCell.Value).Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1)
.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
.Interior.ColorIndex = xlNone
End With
End If
Next aCell
With Workbooks("出勤簿.xlsm")
.Activate
.Worksheets("設定").Select
.Close True
End With
End Sub
（半平太） 2021/06/02(水) 19:54
ご返答ありがとうございました。
エラーも全く起きずに起動いできました！
もし、お時間がありこのページをご覧になられていれば
今後の為に今回のものがどのように改善されたのかご教授お願いできませんでしょうか。
よろしくお願いいたします。
（あああ） 2021/06/03(木) 13:42
＞今回のものがどのように改善されたのか
そう言われましても、そちらの説明に則して書いただけですが。
＞・ボタンをクリックするとマクロを起動 ＞・出勤簿という別ブックを開く 以上は、そちらで組んだ通りです。
＞・マクロブックA列3行目以降に記載されている氏名と ＞ 出勤簿ブックのシート名が一致した場合その行をコピーし行列を入れ替えてペースト ＞・A列が空白になるまで繰り返す。 労務ブックのA列3行目から、ループで氏名を順に見て行く 氏名セルが空白だったら終わりにする。
氏名セルが空白じゃなければ、 氏名セルから２つ右にあるセルを基準に31セルコピーする。 出勤ブック内の「上記氏名と同じ名前のシート」に貼り付ける(※）
※貼付け位置は、表の右端に追記する形にする。 そちらでは、こんな風に分けて書かれていましたが・・
＞ If ws.Cells(2, 2) = "" Then ’前段 ＞ ： ＞ ElseIf ws.Cells(2, 2) <> "" Then ’後段 ＞ ws.Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1).Select ＞ ： ＞ End If
後段だけで同じ意味になります。 B列にデータがなければ、A列まで行って、一つ右ですから、B列スタートになります。
（半平太） 2021/06/03(木) 16:09
ご丁寧にありがとうございました。
勉強になりました。
（あああ） 2021/06/04(金) 11:41
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.