Q&A
早速ご回答ありがとうございます。
おっしゃるとおりの方法ですと、やはり動作が早くなりました。
ほかの方にご教示頂いているfor nextも試してみて、今後のメンテも考えどちらがいいか決めようと思います。
ありがとうございました。
前提・実現したいこと
会社で使用している「購入依頼書」の自動化（VBAとマクロの記録を使用）をしたいのですが、結果は思い通りになったものの、動作が遅く2分近くかかります。
高速化をしたいのでおしえてください。
以下のコードは、「購入依頼書」シートのVBAになります。
初心者ですので、難しいことはよくわかりません。
できるだけ簡単な方法でご教示ください。
何卒よろしくお願いいたします。
発生している問題・エラーメッセージ
ネットで高速化のVBA（以下）を入力しましたが、改善されません。
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
と
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
#
ソースコード
Sub 転記()
'
' 転記 Macro
'
'
'単一セルから単一セルへの転記（21行とばしで転記）
Dim ws As Worksheet '製造・一般、科目の転記
Set ws = Workbooks("マクロ購入依頼書練習.xlsm").Worksheets("③")
Set wsData = Workbooks("マクロ購入依頼書練習.xlsm").Worksheets("購入依頼書")
Dim i As Long
Dim di As Long
'高速化
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
i = 6
di = i + 21
Do While i <= 13
wsData.Cells(6, 1).Value = ws.Cells(i, 2).Value '製造・一般
wsData.Cells(di, 1).Value = ws.Cells(i, 2).Value
wsData.Cells(6, 2).Value = ws.Cells(i, 3).Value '科目
wsData.Cells(di, 2).Value = ws.Cells(i, 3).Value
i = i + 1
di = di + 21
Loop
'単一セルから単一セルへの転記（数量・単位・単価・希望納期）
'単一セルから結合セルへの転記（金額・購入先・備考）
Dim a As Long
Dim b As Long
a = 6
b = a + 3
Do While a <= 59
If b = 15 Or b = 16 Or (b >= 17 And b <= 29) Then
Exit Do
End If
wsData.Cells(b, 6).Value = ws.Cells(a, 5).Value '数量
wsData.Cells(b, 7).Value = ws.Cells(a, 6).Value '単位
wsData.Cells(b, 8).Value = ws.Cells(a, 7).Value '単価
wsData.Cells(b, 11).Value = ws.Cells(a, 9).Value '希望納期
wsData.Cells(b, 2).Value = ws.Cells(a, 4).Value '品名
wsData.Cells(b, 9).Value = ws.Cells(a, 8).Value '金額
wsData.Cells(b, 12).Value = ws.Cells(a, 10).Value '購入先
wsData.Cells(b, 23).Value = ws.Cells(a, 11).Value '備考
Cells(b, 8) = Format(Val(Replace(Cells(b, 8), ",", "")), "#,###") '単価のカンマ（０の場合は表示しない）
Cells(b, 9) = Format(Val(Replace(Cells(b, 9), ",", "")), "#,###") '金額のカンマ（０の場合は表示しない）
a = a + 1
b = b + 1
Loop
Dim c As Long
Dim d As Long
c = 12
d = 30
Do While c <= 59
If d = 36 Or d = 37 Or (d >= 38 And d <= 50) Then
Exit Do
End If
wsData.Cells(d, 6).Value = ws.Cells(c, 5).Value '数量
wsData.Cells(d, 7).Value = ws.Cells(c, 6).Value '単位
wsData.Cells(d, 8).Value = ws.Cells(c, 7).Value '単価
wsData.Cells(d, 11).Value = ws.Cells(c, 9).Value '希望納期
wsData.Cells(d, 2).Value = ws.Cells(c, 4).Value '品名
wsData.Cells(d, 9).Value = ws.Cells(c, 8).Value '金額
wsData.Cells(d, 12).Value = ws.Cells(c, 10).Value '購入先
wsData.Cells(d, 23).Value = ws.Cells(c, 11).Value '備考
Cells(d, 8) = Format(Val(Replace(Cells(d, 8), ",", "")), "#,###") '単価のカンマ
Cells(d, 9) = Format(Val(Replace(Cells(d, 9), ",", "")), "#,###") '金額のカンマ
c = c + 1
d = d + 1
Loop
Dim e As Long
Dim f As Long
e = 18
f = 51
Do While e <= 59
If f = 57 Or f = 58 Or (f >= 59 And f <= 71) Then
Exit Do
End If
wsData.Cells(f, 6).Value = ws.Cells(e, 5).Value '数量
wsData.Cells(f, 7).Value = ws.Cells(e, 6).Value '単位
wsData.Cells(f, 8).Value = ws.Cells(e, 7).Value '単価
wsData.Cells(f, 11).Value = ws.Cells(e, 9).Value '希望納期
wsData.Cells(f, 2).Value = ws.Cells(e, 4).Value '品名
wsData.Cells(f, 9).Value = ws.Cells(e, 8).Value '金額
wsData.Cells(f, 12).Value = ws.Cells(e, 10).Value '購入先
wsData.Cells(f, 23).Value = ws.Cells(e, 11).Value '備考
Cells(f, 8) = Format(Val(Replace(Cells(f, 8), ",", "")), "#,###") '単価のカンマ
Cells(f, 9) = Format(Val(Replace(Cells(f, 9), ",", "")), "#,###") '金額のカンマ
e = e + 1
f = f + 1
Loop
Dim g As Long
Dim h As Long
g = 24
h = 72
Do While g <= 59
If h = 78 Or h = 79 Or (h >= 80 And h <= 92) Then
Exit Do
End If
wsData.Cells(h, 6).Value = ws.Cells(g, 5).Value '数量
wsData.Cells(h, 7).Value = ws.Cells(g, 6).Value '単位
wsData.Cells(h, 8).Value = ws.Cells(g, 7).Value '単価
wsData.Cells(h, 11).Value = ws.Cells(g, 9).Value '希望納期
wsData.Cells(h, 2).Value = ws.Cells(g, 4).Value '品名
wsData.Cells(h, 9).Value = ws.Cells(g, 8).Value '金額
wsData.Cells(h, 12).Value = ws.Cells(g, 10).Value '購入先
wsData.Cells(h, 23).Value = ws.Cells(g, 11).Value '備考
Cells(h, 8) = Format(Val(Replace(Cells(h, 8), ",", "")), "#,###") '単価のカンマ
Cells(h, 9) = Format(Val(Replace(Cells(h, 9), ",", "")), "#,###") '金額のカンマ
g = g + 1
h = h + 1
Loop
Dim j As Long
Dim k As Long
j = 30
k = 93
Do While j <= 59
If k = 99 Or k = 100 Or (k >= 101 And k <= 112) Then
Exit Do
End If
wsData.Cells(k, 6).Value = ws.Cells(j, 5).Value '数量
wsData.Cells(k, 7).Value = ws.Cells(j, 6).Value '単位
wsData.Cells(k, 8).Value = ws.Cells(j, 7).Value '単価
wsData.Cells(k, 11).Value = ws.Cells(j, 9).Value '希望納期
wsData.Cells(k, 2).Value = ws.Cells(j, 4).Value '品名
wsData.Cells(k, 9).Value = ws.Cells(j, 8).Value '金額
wsData.Cells(k, 12).Value = ws.Cells(j, 10).Value '購入先
wsData.Cells(k, 23).Value = ws.Cells(j, 11).Value '備考
Cells(k, 8) = Format(Val(Replace(Cells(k, 8), ",", "")), "#,###") '単価のカンマ
Cells(k, 9) = Format(Val(Replace(Cells(k, 9), ",", "")), "#,###") '金額のカンマ
j = j + 1
k = k + 1
Loop
Dim l As Long
Dim m As Long
l = 36
m = 114
Do While l <= 59
If m = 120 Or m = 121 Or (m >= 122 And m <= 134) Then
Exit Do
End If
wsData.Cells(m, 6).Value = ws.Cells(l, 5).Value '数量
wsData.Cells(m, 7).Value = ws.Cells(l, 6).Value '単位
wsData.Cells(m, 8).Value = ws.Cells(l, 7).Value '単価
wsData.Cells(m, 11).Value = ws.Cells(l, 9).Value '希望納期
wsData.Cells(m, 2).Value = ws.Cells(l, 4).Value '品名
wsData.Cells(m, 9).Value = ws.Cells(l, 8).Value '金額
wsData.Cells(m, 12).Value = ws.Cells(l, 10).Value '購入先
wsData.Cells(m, 23).Value = ws.Cells(l, 11).Value '備考
Cells(m, 8) = Format(Val(Replace(Cells(m, 8), ",", "")), "#,###") '単価のカンマ
Cells(m, 9) = Format(Val(Replace(Cells(m, 9), ",", "")), "#,###") '金額のカンマ
l = l + 1
m = m + 1
Loop
Dim n As Long
Dim o As Long
n = 42
o = 135
Do While n <= 59
If o = 141 Or o = 142 Or (o >= 143 And o <= 155) Then
Exit Do
End If
wsData.Cells(o, 6).Value = ws.Cells(n, 5).Value '数量
wsData.Cells(o, 7).Value = ws.Cells(n, 6).Value '単位
wsData.Cells(o, 8).Value = ws.Cells(n, 7).Value '単価
wsData.Cells(o, 11).Value = ws.Cells(n, 9).Value '希望納期
wsData.Cells(o, 2).Value = ws.Cells(n, 4).Value '品名
wsData.Cells(o, 9).Value = ws.Cells(n, 8).Value '金額
wsData.Cells(o, 12).Value = ws.Cells(n, 10).Value '購入先
wsData.Cells(o, 23).Value = ws.Cells(n, 11).Value '備考
Cells(o, 8) = Format(Val(Replace(Cells(o, 8), ",", "")), "#,###") '単価のカンマ
Cells(o, 9) = Format(Val(Replace(Cells(o, 9), ",", "")), "#,###") '金額のカンマ
n = n + 1
o = o + 1
Loop
Dim p As Long
Dim q As Long
p = 48
q = 156
Do While p <= 59
If q = 162 Or q = 163 Or (q >= 164 And q <= 176) Then
Exit Do
End If
wsData.Cells(q, 6).Value = ws.Cells(p, 5).Value '数量
wsData.Cells(q, 7).Value = ws.Cells(p, 6).Value '単位
wsData.Cells(q, 8).Value = ws.Cells(p, 7).Value '単価
wsData.Cells(q, 11).Value = ws.Cells(p, 9).Value '希望納期
wsData.Cells(q, 2).Value = ws.Cells(p, 4).Value '品名
wsData.Cells(q, 9).Value = ws.Cells(p, 8).Value '金額
wsData.Cells(q, 12).Value = ws.Cells(p, 10).Value '購入先
wsData.Cells(q, 23).Value = ws.Cells(p, 11).Value '備考
Cells(q, 8) = Format(Val(Replace(Cells(q, 8), ",", "")), "#,###") '単価のカンマ
Cells(q, 9) = Format(Val(Replace(Cells(q, 9), ",", "")), "#,###") '金額のカンマ
p = p + 1
q = q + 1
Loop
Dim r As Long
Dim s As Long
r = 54
s = 177
Do While r <= 59
If s = 162 Or s = 163 Or (s >= 164 And s <= 176) Then
Exit Do
End If
wsData.Cells(s, 6).Value = ws.Cells(r, 5).Value '数量
wsData.Cells(s, 7).Value = ws.Cells(r, 6).Value '単位
wsData.Cells(s, 8).Value = ws.Cells(r, 7).Value '単価
wsData.Cells(s, 11).Value = ws.Cells(r, 9).Value '希望納期
wsData.Cells(s, 2).Value = ws.Cells(r, 4).Value '品名
wsData.Cells(s, 9).Value = ws.Cells(r, 8).Value '金額
wsData.Cells(s, 12).Value = ws.Cells(r, 10).Value '購入先
wsData.Cells(s, 23).Value = ws.Cells(r, 11).Value '備考
Cells(s, 8) = Format(Val(Replace(Cells(s, 8), ",", "")), "#,###") '単価のカンマ
Cells(s, 9) = Format(Val(Replace(Cells(s, 9), ",", "")), "#,###") '金額のカンマ
r = r + 1
s = s + 1
Loop
'高速化
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
試したこと
発生している問題・エラーメッセージ（上記）と同様
補足情報（FW/ツールのバージョンなど）
以下のような流れで、操作できるようにしています。（いずれも同ブック内の動作）
１．シート①に他のブックからの経理一覧データ（経費科目ごとに記載された購入する物品の名称・金額・数量など記載したもの）をコピペ。
２．シート②で「データ編集」ボタン（マクロの記録）を押し、「購入依頼書」に転記するために必要なデータをシート①から搾りこみ、「購入依頼書」に合わせた表示順に整える。
３．シート③で購入依頼書に転記したい（経費科目/購入依頼部門/購入部門など）をプルダウン（リストを使用）から選択し、「表示」ボタン（マクロの記録）で、科目ごと（購入する物品と数量・その金額や購入先）表示し転記できるように整える。
※「購入依頼書」は、経費科目ごと購入物品の転記が必要なため
また、左余白に経費科目を転記するため。
４．「購入依頼書」シートでは、「転記」ボタン（VBAでLoopを使用）を押し、シート③で表示した内容を転記する。
※１枚の「購入依頼書」には最大6つまで購入物品の記載が可能。
３枚の購入依頼書がA4に収まるような仕様になっている。
経費科目が増えることを想定し、「購入依頼書」シートには、9枚分転記できるように設定してある。
以上、よろしくお願いいたします。
回答3件
0
こんな感じでどうでしょうか。（少し修正してみました）
VBA
1Sub 転記() 2 Dim ws As Worksheet 3 Dim wsdata As Worksheet 4 Set ws = Workbooks("マクロ購入依頼書練習.xlsm").Worksheets("③") 5 Set wsdata = Workbooks("マクロ購入依頼書練習.xlsm").Worksheets("購入依頼書") 6 7 '高速化 8 Application.ScreenUpdating = False 9 Application.Calculation = xlCalculationManual 10 11 Dim i, j, x, h 12 i = 6 '転記元の開始行 13 x = 6 '６行ごと 14 h = Array(ws.Range("E1").Value, ws.Range("E2").Value) 15 With wsdata 16 For j = 6 To 174 Step 21 17 .Cells(j, 1).Resize(, 2).Value = h '一般, 科目 18 .Cells(j + 3, 2).Resize(x).Value = ws.Cells(i, 4).Resize(x).Value '品名 19 .Cells(j + 3, 6).Resize(x, 4).Value = ws.Cells(i, 5).Resize(x, 4).Value '数量～金額 20 .Cells(j + 3, 11).Resize(x, 2).Value = ws.Cells(i, 9).Resize(x, 2).Value '希望納期～購入先 21 .Cells(j + 3, 23).Resize(x).Value = ws.Cells(i, 11).Resize(x).Value '備考 22 .Cells(j + 3, 8).Resize(x, 2).NumberFormatLocal = "#,###;;" '単価,金額のカンマ（０の場合は表示しない） 23 i = i + x 24 Next 25 End With 26 27 '高速化 28 Application.Calculation = xlCalculationAutomatic 29 Application.ScreenUpdating = True 30 31 '終了 32 CreateObject("WScript.Shell").Popup "終了しました", 3, "終了", vbInformation 33 34End Sub
投稿2021/08/28 12:03
編集2021/08/29 05:18
総合スコア4585
0
VBA
1wsData.Cells(b, 6).Value = ws.Cells(a, 5).Value '数量 2wsData.Cells(b, 7).Value = ws.Cells(a, 6).Value '単位 3wsData.Cells(b, 8).Value = ws.Cells(a, 7).Value '単価
のようにループしながら1つずつ値を取得しては入れてを繰り返すのではなく、以下のようにある程度まとめてコピーすれば良いのではないでしょうか。
値によって処理を変えるわけでもなく、ループの範囲が固定で決まっているならば、ループして入れる意味はないでしょう。
VBA
1wsData.Range("F9:H14").Value = ws.Range("E6:G11").Value 2
投稿2021/08/28 10:12
総合スコア509
0
自己解決
Sub データ編集()
'
' データ編集 Macro
'
'
Dim ws As Worksheet
Set ws = Workbooks("マクロ購入依頼書練習.xlsm").Worksheets("①")
Set wsData = Workbooks("マクロ購入依頼書練習.xlsm").Worksheets("②")
'高速化
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'①にデータが正しい位置に貼り付けられていない場合、MSGBOXで注意喚起
If ws.Range("P5").Value <> "" Then
ActiveWindow.SmallScroll Down:=0 Sheets("①").Select ActiveSheet.Range("$B$5:$P$305").AutoFilter Field:=15, Criteria1:="○" ActiveWindow.SmallScroll Down:=0 Range("B5:N305").Select Selection.Copy ActiveWindow.SmallScroll Down:=0 Sheets("②").Select Range("B5").Select ActiveSheet.Paste Columns("B:C").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Columns("F:F").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("F6").Select ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]" Range("F6").Select Selection.AutoFill Destination:=Range("F6:F237"), Type:=xlFillDefault Range("F6:F237").Select ActiveWindow.SmallScroll Down:=-216 Range("F5").Select ActiveCell.FormulaR1C1 = "品名（メーカー・型式）" ActiveCell.Characters(1, 2).PhoneticCharacters = "ヒンメイ" ActiveCell.Characters(9, 2).PhoneticCharacters = "カタシキ" Range("F6").Select ActiveWindow.SmallScroll Down:=-9 Columns("F:F").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("E3").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "" Columns("D:E").Select Range("E1").Activate Selection.Delete Shift:=xlToLeft Columns("I:I").Select Selection.Delete Shift:=xlToLeft Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("I5").Select ActiveCell.FormulaR1C1 = "希望納期" ActiveCell.Characters(1, 4).PhoneticCharacters = "キボウノウキ" Columns("B:K").Select Range("K1").Activate Columns("B:K").EntireColumn.AutoFit Range("I6").Select With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=リスト!$C$2:$C$19" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With Selection.AutoFill Destination:=Range("I6:I237"), Type:=xlFillDefault Range("I6:I237").Select ActiveWindow.SmallScroll Down:=-225 Else MsgBox "データ貼りつけ位置に誤りがあります。" & vbCrLf & "シート①で貼りつけし直してください。", vbCritical End If
'高速化
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub 表示()
'
' 表示 Macro
'
'
'高速化 Application.ScreenUpdating = False Sheets("②").Select Range("L6").Select ActiveCell.FormulaR1C1 = _ "=IF(AND(RC[-10]=③!R[-5]C[-7],③!R[-4]C[-7]=②!RC[-9]),""OK"",""NG"")" Range("L6").Select ActiveCell.FormulaR1C1 = _ "=IF(AND(RC[-10]=③!R1C5,③!R2C5=②!RC[-9]),""OK"",""NG"")" Range("L6").Select Selection.AutoFill Destination:=Range("L6:L237") Range("L6:L237").Select Sheets("③").Select Range("B6").Select ActiveCell.FormulaR1C1 = "=IF(②!RC[10]=""OK"",②!RC,"""")" Range("C6").Select ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",②!RC,"""")" Range("C6").Select Selection.AutoFill Destination:=Range("C6:K6"), Type:=xlFillDefault Range("C6:K6").Select Range("L6").Select ActiveCell.FormulaR1C1 = "=IF(RC[-4]<>"""","""",""削除"")" Range("B6:L6").Select Selection.AutoFill Destination:=Range("B6:L835"), Type:=xlFillDefault Range("B6:L835").Select Range("O821").Select ActiveWindow.ScrollRow = 203 ActiveWindow.LargeScroll Down:=1 ActiveWindow.ScrollRow = 106 ActiveWindow.ScrollRow = 103 ActiveWindow.ScrollRow = 96 ActiveWindow.LargeScroll Down:=-2 ActiveWindow.ScrollRow = 14 ActiveWindow.ScrollRow = 13 ActiveWindow.ScrollRow = 11 ActiveWindow.ScrollRow = 9 ActiveWindow.ScrollRow = 8 ActiveWindow.ScrollRow = 6 ActiveWindow.ScrollRow = 1 ActiveSheet.Range("$B$5:$M$835").AutoFilter Field:=11, Criteria1:="<>" Rows("6:835").Select Selection.Delete Shift:=xlUp ActiveSheet.Range("$B$5:$M$7").AutoFilter Field:=11 '高速化 Application.Calculation = xlCalculationManual '選択した科目の情報がない場合、MSGBOXで警告 If Range("B6").Value = "" Then MsgBox "データが存在しません。科目を選択し直してください。", vbExclamation Else 'データの絞り込みが完了したことをMSGBOXで知らせる MsgBox "転記データの絞り込みが完了しました！", vbInformation End If '高速化 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True
End Sub
Sub 転記()
'
' 転記 Macro
'
'
'シート③のデータをシート「購入依頼書」に転記（21行とばしで転記）
Dim ws As Worksheet
Set ws = Workbooks("マクロ購入依頼書練習.xlsm").Worksheets("③")
Set wsData = Workbooks("マクロ購入依頼書練習.xlsm").Worksheets("購入依頼書")
'高速化
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'製造・一般、科目の転記
wsData.Range("A6").Value = ws.Range("E1").Value '製造・一般
wsData.Range("A27").Value = ws.Range("E1").Value '製造・一般
wsData.Range("A48").Value = ws.Range("E1").Value '製造・一般
wsData.Range("A69").Value = ws.Range("E1").Value '製造・一般
wsData.Range("A90").Value = ws.Range("E1").Value '製造・一般
wsData.Range("A111").Value = ws.Range("E1").Value '製造・一般
wsData.Range("A132").Value = ws.Range("E1").Value '製造・一般
wsData.Range("A153").Value = ws.Range("E1").Value '製造・一般
wsData.Range("A174").Value = ws.Range("E1").Value '製造・一般
wsData.Range("B6").Value = ws.Range("E2").Value '科目
wsData.Range("B27").Value = ws.Range("E2").Value '科目
wsData.Range("B48").Value = ws.Range("E2").Value '科目
wsData.Range("B69").Value = ws.Range("E2").Value '科目
wsData.Range("B90").Value = ws.Range("E2").Value '科目
wsData.Range("B111").Value = ws.Range("E2").Value '科目
wsData.Range("B132").Value = ws.Range("E2").Value '科目
wsData.Range("B153").Value = ws.Range("E2").Value '科目
wsData.Range("B174").Value = ws.Range("E2").Value '科目
Dim i, j, x
x = 6 '６行ごと
j = 9 '転記先の行
For i = 6 To 54 Step x
wsData.Cells(j, 2).Resize(x).Value = ws.Cells(i, 4).Resize(x).Value '品名
wsData.Cells(j, 6).Resize(x, 4).Value = ws.Cells(i, 5).Resize(x, 4).Value '数量～金額
wsData.Cells(j, 11).Resize(x, 2).Value = ws.Cells(i, 9).Resize(x, 2).Value '希望納期～購入先
wsData.Cells(j, 23).Resize(x).Value = ws.Cells(i, 11).Resize(x).Value '備考
wsData.Cells(j, 8).Resize(x, 2).NumberFormatLocal = "#,###;;" '単価,金額のカンマ（０の場合は表示しない）
j = j + 21
Next
'高速化
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'データ転記が完了したことをMSGBOXで知らせる
MsgBox "データ転記が完了しました！", vbInformation
End Sub
投稿2021/08/29 06:08
総合スコア0
お二人ともお忙しい中、ありがとうございます！
助かりました。
早速明日、会社で試してみます。
ただ、３枚目のシート「購入依頼書」は処理迄25秒はかかるので、まだ若干改善の余地があるようですが・・・。
因みに、コピペしただけでもさほど処理時間は変わりませんでした。
IFでMSGBOXを入れているからでしょうか？
また、何かありましたら宜しくお願いいたします。
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2021/08/29 02:55
2021/08/29 03:34
2021/08/29 03:49
2021/08/29 05:22
2021/08/29 06:18