回答編集履歴

1

追記

2017/05/10 03:14

投稿

hatena19
hatena19

スコア33782

test CHANGED
@@ -25,3 +25,83 @@
25
25
 
26
26
 
27
27
  コードの書き方でいろいろ指摘したいところはありますが、とりあえず質問だけに回答です。
28
+
29
+
30
+
31
+ 追記
32
+
33
+ ---
34
+
35
+ 前の回答者さんと内容がかぶってしまったので、
36
+
37
+ 指摘したいところを追記しておきます。
38
+
39
+
40
+
41
+ 不必要な変数宣言、不適切な型指定
42
+
43
+ 変数名も紛らわしい
44
+
45
+ 移動なら、copyではなく cutメソッドを使えば1行で済む
46
+
47
+ など、
48
+
49
+ これらを考慮したコード例
50
+
51
+ ```
52
+
53
+ Sub コピペボタン()
54
+
55
+ Dim 検索セル As Range
56
+
57
+ Dim 対象セル As Range
58
+
59
+ Dim 結果 As Variant, 検索社番 As Variant
60
+
61
+
62
+
63
+ Range("P8") = "" '過去の社番をクリアにする
64
+
65
+ Set 検索セル = ActiveCell
66
+
67
+
68
+
69
+ If 検索セル.Value = "" Then
70
+
71
+ MsgBox "対象セルを選択して下さい"
72
+
73
+ Exit Sub
74
+
75
+ End If
76
+
77
+
78
+
79
+ 検索社番 = (Left(検索セル.Value, 5)) '後ろ5ケタ社番
80
+
81
+ Range("P8").Value = 検索社番 'P8セルに社番表示
82
+
83
+ 結果 = Range("P10").Value 'P8セル社番を検索値としてVLOOKUPにて結果表示
84
+
85
+
86
+
87
+ On Error GoTo myError
88
+
89
+ Set 対象セル = Application.InputBox("移動先セルを選択してください", 結果, Type:=8)
90
+
91
+
92
+
93
+ 検索セル.Cut 対象セル '検索セルの内容を対象セルに移動
94
+
95
+
96
+
97
+ Exit Sub
98
+
99
+ myError:
100
+
101
+ MsgBox "実行時エラー" & Err.Number & ":" & vbCrLf & Err.Description
102
+
103
+ End Sub
104
+
105
+ ```
106
+
107
+