質問するログイン新規登録

回答編集履歴

1

コードにコメントを追加

2017/12/01 16:22

投稿

imihito
imihito

スコア2166

answer CHANGED
@@ -13,7 +13,7 @@
13
13
  Sub 見積書DB化2()
14
14
  '前提条件
15
15
  '- 転記元のシートを前面に表示していること
16
- '- 転記先のシートがこのマクロが書かれいるブックであること
16
+ '- 転記先のシートがこのマクロが書かれいるブックであること
17
17
 
18
18
  If Excel.ThisWorkbook Is Excel.ActiveWorkbook Then
19
19
  Stop '転記先と転記元が同じブック
@@ -31,7 +31,7 @@
31
31
  Set pasteWs = Excel.ThisWorkbook.ActiveSheet
32
32
 
33
33
  '入力する空白セルの指定
34
- Dim pasteCell As Excel.Range
34
+ Dim pasteCell As Excel.Range '元の処理の`InputRow`に相当する場所のセル
35
35
  Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "A").End(xlUp).Offset(1)
36
36
 
37
37
  '見積もり番号を開いている転記元からコピーして転記先にペースト
@@ -44,9 +44,11 @@
44
44
  SkipBlanks:=False, _
45
45
  Transpose:=False
46
46
  'コピペは以下でも可
47
- 'pasteCell.Value = mitumoriCell.Value
47
+ 'pasteCell.Value() = mitumoriCell.Value()
48
48
 
49
+
49
50
  '件名'を開いている転記元からコピーして転記先にペースト
51
+ '見積もり番号とやっていることはほぼ同じ
50
52
  Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlUp).Offset(1)
51
53
 
52
54
  Dim kenmeiCell As Excel.Range
@@ -58,9 +60,11 @@
58
60
  SkipBlanks:=False, _
59
61
  Transpose:=False
60
62
  'コピペは以下でも可
61
- 'pasteCell.Value = kenmeiCell.Value
63
+ 'pasteCell.Value() = kenmeiCell.Value()
62
64
 
65
+
63
66
  '納入期日'を開いている転記元からコピーして転記先にペースト
67
+ '見積もり番号とやっていることはほぼ同じ
64
68
  Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "C").End(xlUp).Offset(1)
65
69
 
66
70
  Dim nonyuCell As Excel.Range
@@ -72,8 +76,9 @@
72
76
  SkipBlanks:=False, _
73
77
  Transpose:=False
74
78
  'コピペは以下でも可
75
- 'pasteCell.Value = nonyuCell.Value
79
+ 'pasteCell.Value() = nonyuCell.Value()
76
80
 
81
+
77
82
  '品名'を開いている転記元からコピーして転記先にペースト
78
83
  Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "D").End(xlUp).Offset(1)
79
84
 
@@ -84,16 +89,22 @@
84
89
  .Range("C18"), _
85
90
  .Range("C18").End(xlDown) _
86
91
  )
92
+ '以下処理で選択したセルと同じものを取得しているはずです
93
+ 'Range("C18").Select
94
+ 'Range(Selection, Selection.End(xlDown)).Select
95
+
87
96
  End With 'copyWs
88
97
 
98
+
89
99
  hinmeiCell.Copy
90
100
  pasteCell.PasteSpecial Paste:=xlPasteValues, _
91
101
  Operation:=xlNone, _
92
102
  SkipBlanks:=False, _
93
103
  Transpose:=False
94
104
  'コピペは以下でも可
95
- 'pasteCell.Resize(hinmeiCell.Rows.Count).Value = hinmeiCell.Value
105
+ 'pasteCell.Resize(hinmeiCell.Rows.Count).Value() = hinmeiCell.Value()
96
106
 
107
+
97
108
  '数量~金額'を開いている転記元からコピーして転記先にペースト
98
109
  Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "E").End(xlUp).Offset(1)
99
110
 
@@ -104,6 +115,12 @@
104
115
  .Range("F18:I18"), _
105
116
  .Range("F18:I18").End(xlToRight).End(xlDown) _
106
117
  )
118
+ '以下処理で選択したセルと同じものを取得しているはずです
119
+ '元々入っていたので`.End(xlToRight)`を入れていますが要るのでしょうか?
120
+ 'Range("F18:I18").Select
121
+ 'Range(Selection, Selection.End(xlToRight)).Select
122
+ 'Range(Selection, Selection.End(xlDown)).Select
123
+
107
124
  End With 'copyWs
108
125
 
109
126
  suryo_kingakuCell.Copy
@@ -113,7 +130,7 @@
113
130
  Transpose:=False
114
131
  'コピペは以下でも可
115
132
  'With suryo_kingakuCell
116
- 'pasteCell.Resize(.Rows.Count, .Columns.Count).Value = .Value
133
+ 'pasteCell.Resize(.Rows.Count, .Columns.Count).Value() = .Value()
117
134
  'End With 'suryo_kingakuCell
118
135
 
119
136
  End Sub