[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『取得元からデータ転記（取得元が毎月移動）』（りき）
マクロの変数で作成しようとしましたが、うまくいきません。
よろしくお願いします。
月初めに一度だけ、取得元から転記先へ値のコピーをしたいです。取得元のデータは毎月移動します。（1月〜12月の実績があるため。P3、P4...P14）転記先は、常に同じです。
取得元は、３ヶ所あります。
P3…P14 → B13（常に同じ）
P21…P32 → B14（常に同じ）
P39…P50 → B15（常に同じ）
取得元
パス C:\Users\○○○\Documents\01 実績表.xlsx
シート ４期実績
転記先
パス （直接開いてマクロを実行する）
シート 当該シートと指定できる？（シート名変更の可能性あり）
もしできるなら翌年は、Q3...Q14。
これを転記先のエクセルから実行したいです。どうかご教授お願い致します。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
こんばんは。。。＾＾ データを拝見できませんので、 よくわかりませんが、 ＞＞もしできるなら翌年は、Q3...Q14。 そのまま、行けるところまで[重くならず、切の良い処＾＾；] P〜〜〜〜〜のほうが良い様な、横に並べるとあまり良い事は 起こりません。。。と思います。。。 （隠居じーさん） 2021/04/08(木) 19:27
こんばんは ＾＾ また、私の勘違いかも レス、（隠居じーさん） 2021/04/08(木) 19:27 は、無かったことにしてください。済みませんでした。 m(_ _)m （隠居じーさん） 2021/04/08(木) 19:47
どのようにうまくいきませんか？
無理にとは言いませんが、現状のコードを提示いただいて、エラーになるならその箇所・エラー番号・エラーメッセージを、エラーにはならないが思った通りにならないなら××になるはずが○○になってしまう。というように説明いただくと、回答者側で状況が把握しやすいので、諸々提示してみてはいかがでしょうか？
（もこな２ ） 2021/04/08(木) 20:03
１）転記先ブックに、作業用シート作成
２）取得元のP3:P14をコピーし、１）のB列にリンク貼り付け
３）取得元のP21:P32をコピーし、１）のB列にリンク貼り付け
４）取得元のP39:P50をコピーし、１）のB列にリンク貼り付け
５）１）のA列に、１月〜12月を入力
６）１）のD1に転記したい実績月を入力
７）転記先シートのB13、B14、B15にVLOOKUPの数式
（マナ） 2021/04/08(木) 20:43
それが、色々ためしたのですが、全くできない状況で困っているのです。初心者で申し訳ございません。
マナさん
そこで、マサさんの書き込みで思いついたのですが、取得元から一気に
P3:P14 → L3:L14 P21:P32 → M3:M14 P39:P50 → N3:N14 に転記してから処理の仕方を検討しようと思いますっていますが、下記の数式がうまくいきません。どこが誤りでしょうか。アドバイスお願い致します。
Range("L3:L14") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R3C16:!R14C16")
（りき） 2021/04/09(金) 11:33
"色々ためした"のであれば、同じことを案内しても無駄でしょうからそれも提示いただいたほうがよいです。
（もこな２） 2021/04/09(金) 12:10
すみません。コードはこれです。
Dim i As Long Dim j As Long
For i = 13 To 15
For j = 3 To 14
Cells(i, 2) = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!Cells(j , 16)")
Next j Next i
Range("A1").Select
End Sub
ですが、エラーになり、さらに取得元のセルを移動する事は、全くわかりません。
こんな感じなのですが、すみません。
（りき） 2021/04/09(金) 15:41
Sub テキトー()
Dim 月 As Long
On Error Resume Next
月 = InputBox("何月? (１〜12の数値で入力)")
On Error GoTo 0
If 月 < 1 Or 月 > 12 Then
MsgBox "入力値エラー"
Exit Sub
End If
With Workbooks.Open("C:\Users\○○○\Documents\01 実績表.xlsx").Worksheets("４期実績")
ThisWorkbook.Worksheets(1).Range("B3").Value = .Cells(2, "P").Offset(月).Value
ThisWorkbook.Worksheets(1).Range("B14").Value = .Cells(20, 16).Offset(月).Value
ThisWorkbook.Worksheets(1).Range("B15").Value = .Cells(38, 16).Offset(月).Value
.Parent.Close False
End With
End Sub
＞もしできるなら翌年は〜
何を以て"翌年"と判定するのか知りませんが、P列(16列目)じゃなくてQ列（17列目）にすればいいのだからさして難しくないですね。
（もこな２） 2021/04/09(金) 21:13
要領の悪い返答で申し訳ないです。コードがそもそもできなくて書いては消しての繰り返しをしていたもので、すみません。
考え方を変えて最初から取得元のP3…P14、P21…P32、P39…P50を全て転記先へコピーし、０の値を削除してからB13、B14、B15へ貼り付けという手法を考えてみました。
翌年取込は、手動で直すしかできないやりかたですが。
Sub 取込()
Range("L2") = "実績１"
Range("M2") = "実績２"
Range("N2") = "実績３"
Dim i As Long Dim j As Long Dim k As String
j = 1 k = "月"
For i = 3 To 14
Cells(i, 11) = j & k
j = j + 1
Next i
Range("L3") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R3C16")
Range("L4") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R4C16")
Range("L5") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R5C16")
Range("L6") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R6C16")
Range("L7") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R7C16")
Range("L8") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R8C16")
Range("L9") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R9C16")
Range("L10") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R10C16")
Range("L11") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R11C16")
Range("L12") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R12C16")
Range("L13") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R13C16")
Range("L14") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R14C16")
Range("M3") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R21C16")
Range("M4") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R22C16")
Range("M5") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R23C16")
Range("M6") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R24C16")
Range("M7") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R25C16")
Range("M8") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R26C16")
Range("M9") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R27C16")
Range("M10") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R28C16")
Range("M11") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R29C16")
Range("M12") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R30C16")
Range("M13") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R31C16")
Range("M14") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R32C16")
Range("N3") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R39C16")
Range("N4") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R40C16")
Range("N5") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R41C16")
Range("N6") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R42C16")
Range("N7") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R43C16")
Range("N8") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R44C16")
Range("N9") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R45C16")
Range("N10") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R46C16")
Range("N11") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R47C16")
Range("N12") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R48C16")
Range("N13") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R49C16")
Range("N14") = ExecuteExcel4Macro("'C:\Users\○○○\Documents\01 資料\[01 実績表.xlsx]４期実績'!R50C16")
Dim c As Range
For Each c In Range("L3:N14")
If c.Value = 0 Then c.Value = ""
Next c
Range("L2").Select
Selection.End(xlDown).Select
Selection.Copy
Range("B13").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("M2").Select
Selection.End(xlDown).Select
Selection.Copy
Range("B14").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("N2").Select
Selection.End(xlDown).Select
Selection.Copy
Range("B15").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("K2:N14").Select
Selection.ClearContents
Range("A1").Select
End Sub
（りき） 2021/04/12(月) 11:52
■１
VBAの世界では、基本的にブック、シートやセルなど（オブジェクトといいます）を明示すれば、いちいち選択したり、アクティブにしたりする必要はありません。
■２
「標準モジュール」で「Range("A1")」のような書き方をした場合、「ActiveSheet.Range("A1")」のようにアクティブシートを指定したものとして扱われます。
また、「Worksheets(1)」のように、ブックを指定しない場合も同様にアクティブブックを指定したものとして見なされるルールです。
したがって、複数のシートやブックを相手にするようなったら、想定外のシートやブックを対象にしないためにも、１と併せて対象のオブジェクトは明示したほうがよいとおもいます。
■３
今回は不採用のようですが、ブックを開いてしまったほうがいろいろと楽ちんなこともあると思いますので余力があれば上記に留意のうえ検討してみてください。
■４
ということを踏まえて提示のコードを私なりに改造するとこんな感じです。興味があればステップ実行して研究してみてください。
Sub 別案()
Dim srcSH As Worksheet
Dim tmpRNG As Range, bufRNG As Range
Stop 'ブレークポイントの代わり
With ActiveSheet
.Range("L2:N2").Value = Array("実績１", "実績２", "実績３")
.Range("K3").Value = "1月"
.Range("K3").AutoFill Destination:=.Range("K3:K14"), Type:=xlFillDefault
Set srcSH = Workbooks.Open("C:\Users\○○○\Documents\01 資料\01 実績表.xlsx").Worksheets("４期実績")
srcSH.Range("P3:P14").Copy
.Range("L3").PasteSpecial Paste:=xlPasteValues
srcSH.Range("P21:P32").Copy
.Range("M3").PasteSpecial Paste:=xlPasteValues
srcSH.Range("P39:P50").Copy
.Range("N3").PasteSpecial Paste:=xlPasteValues
srcSH.Parent.Close False
For Each bufRNG In .Range("L3:N14")
If bufRNG.Value = 0 Or bufRNG.Value = "" Then
If tmpRNG Is Nothing Then
Set tmpRNG = bufRNG
Else
Set tmpRNG = Union(tmpRNG, bufRNG)
End If
End If
Next bufRNG
If Not tmpRNG Is Nothing Then tmpRNG.ClearContents
.Range("B13").Value = .Range("L2").End(xlDown).Value
.Range("B14").Value = .Range("M2").End(xlDown).Value
.Range("B15").Value = .Range("N2").End(xlDown).Value
.Range("K2:N14").ClearContents
.Range("A1").Select
End With
End Sub
■５
さらに上記を改造して↓でもよさそうですね。
Sub 別案2()
Dim srcSH As Worksheet
Dim i As Long
Stop 'ブレークポイントの代わり
With ActiveSheet
.Range("L2:N2").Value = Array("実績１", "実績２", "実績３")
.Range("K3").Value = "1月"
.Range("K3").AutoFill Destination:=.Range("K3:K14"), Type:=xlFillDefault
Set srcSH = Workbooks.Open("C:\Users\○○○\Documents\01 資料\01 実績表.xlsx").Worksheets("４期実績")
For i = 3 To 14 Step 1
If srcSH.Cells(i, "P").Value <> "" And srcSH.Cells(i, "P").Value <> 0 Then
.Range("B13").Value = srcSH.Cells(i, "P").Value
Exit For
End If
Next i
For i = 21 To 32 Step 1
If srcSH.Cells(i, "P").Value <> "" And srcSH.Cells(i, "P").Value <> 0 Then
.Range("B14").Value = srcSH.Cells(i, "P").Value
Exit For
End If
Next i
For i = 39 To 50 Step 1
If srcSH.Cells(i, "P").Value <> "" And srcSH.Cells(i, "P").Value <> 0 Then
.Range("B15").Value = srcSH.Cells(i, "P").Value
Exit For
End If
Next i
.Range("A1").Select
End With
End Sub
■６
尤も↓なのですから、頑張れば「月」は分かりそうな気がしますが。
＞月初めに一度だけ〜
（もこな２） 2021/04/12(月) 21:36
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.