teratail
回答率
85.38%
teratail 10th-anniversary
teratail 10th-anniversary
質問するログイン新規登録
トップに関する質問VBA 型が一致しない

編集履歴

質問編集履歴

3

更新

2020/08/13 13:55

投稿

yakumo02
yakumo02

スコア103

test CHANGED
File without changes
test CHANGED
@@ -1,173 +1 @@
1
- 以下はセルの範囲を取得し、2次元配列で範囲のデータを取得できるようにしたものです。
2
-
3
- Doの中の If rfdata4(p, 1) Like target Thenで型が一致しないエラーが起きてしまいます。
4
-
5
- どのようにすれば、解消できるのでしょうか？
6
-
7
- 関数で2つの値を返そうとしています
8
-
9
- ```
10
-
11
- Function tes(target, filename) As Long()
12
-
13
-
14
-
15
- Dim s2 As String
16
-
17
- this_line2 = ThisWorkbook.Worksheets("Sheet3").Cells(Rows.Count, 4).End(xlUp).Row 'ブックの最終行を取得
18
-
19
-
20
-
21
- s2 = ("D1:" & "D" & CStr(this_line2))　'D1:D14
22
-
23
-
24
-
25
- Dim rfdata3 As Variant
26
-
27
- rfdata3 = ThisWorkbook.Worksheets("Sheet3").Range(s2)
28
-
29
-
30
-
31
- ReDim rfdata4(1 To this_line2, 1) As Variant
32
-
33
- For i = 1 To UBound(rfdata3, 1)
34
-
35
- rfdata4(i, 1) = rfdata3(i, 1)
36
-
37
- Next i
38
-
39
- 'rfdata4(2,1)などでデータを参照できる
40
-
41
- Lavel3:
42
-
43
-
44
-
45
- Do While UBound(rfdata4, 1) > p
46
-
47
-
48
-
49
-
50
-
51
- If rfdata4(p, 1) Like target Then 'ここでエラー
1
+ 編集中。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。
52
-
53
-
54
-
55
- neko(0) = 1
56
-
57
-
58
-
59
- Exit Do
60
-
61
-
62
-
63
- Else
64
-
65
- p = p + 1
66
-
67
- End If
68
-
69
- neko(0) = 2
70
-
71
- GoTo Lavel3
72
-
73
- Loop
74
-
75
- tes = neko
76
-
77
-
78
-
79
- '-----------------------------------------処理2　同じようなこと
80
-
81
-
82
-
83
- this_line = Workbooks(filename).Worksheets("説明").Cells(Rows.Count, 81).End(xlUp).Row
84
-
85
-
86
-
87
- Dim s As String
88
-
89
-
90
-
91
- s = ("CC10:" & "CC" & CStr(this_line))
92
-
93
-
94
-
95
- Dim refata As Variant
96
-
97
-
98
-
99
- rfdata = Workbooks(filename).Worksheets("説明").Range(s)
100
-
101
- k = 1
102
-
103
-
104
-
105
- ReDim rfdata2(1 To this_line, 1) As Variant
106
-
107
- For i = 1 To UBound(rfdata, 1)
108
-
109
- If WorksheetFunction.IsText(rfdata(i, 1)) Then
110
-
111
- rfdata2(k, 1) = rfdata(i, 1)
112
-
113
- k = k + 1
114
-
115
- End If
116
-
117
- Next i
118
-
119
-
120
-
121
-
122
-
123
- Application.ScreenUpdating = False
124
-
125
- Lavel2:
126
-
127
- Do While UBound(rfdata2, 1) > o
128
-
129
-
130
-
131
- ThisWorkbook.Activate
132
-
133
-
134
-
135
- If rfdata2(o, 1) Like target Then
136
-
137
-
138
-
139
- neko(1) = 1
140
-
141
-
142
-
143
- Exit Do
144
-
145
-
146
-
147
- Else
148
-
149
-
150
-
151
- o = o + 1
152
-
153
- End If
154
-
155
- neko(1) = 2
156
-
157
- GoTo Lavel2
158
-
159
- Loop
160
-
161
- Workbooks(filename).Close
162
-
163
- tes = neko
164
-
165
-
166
-
167
-
168
-
169
- Application.ScreenUpdating = True
170
-
171
- End Function
172
-
173
- ```

2

更新

2020/08/13 13:55

投稿

yakumo02
yakumo02

スコア103

test CHANGED
File without changes
test CHANGED
@@ -4,7 +4,7 @@
4
4
 
5
5
  どのようにすれば、解消できるのでしょうか？
6
6
 
7
-
7
+ 関数で2つの値を返そうとしています
8
8
 
9
9
  ```
10
10
 
@@ -76,7 +76,7 @@
76
76
 
77
77
 
78
78
 
79
- '-----------------------------------------処理2
79
+ '-----------------------------------------処理2　同じようなこと
80
80
 
81
81
 
82
82
 

1

更新

2020/08/13 12:14

投稿

yakumo02
yakumo02

スコア103

test CHANGED
File without changes
test CHANGED
@@ -7,6 +7,10 @@
7
7
 
8
8
 
9
9
  ```
10
+
11
+ Function tes(target, filename) As Long()
12
+
13
+
10
14
 
11
15
  Dim s2 As String
12
16
 
@@ -68,4 +72,102 @@
68
72
 
69
73
  Loop
70
74
 
75
+ tes = neko
76
+
77
+
78
+
79
+ '-----------------------------------------処理2
80
+
81
+
82
+
83
+ this_line = Workbooks(filename).Worksheets("説明").Cells(Rows.Count, 81).End(xlUp).Row
84
+
85
+
86
+
87
+ Dim s As String
88
+
89
+
90
+
91
+ s = ("CC10:" & "CC" & CStr(this_line))
92
+
93
+
94
+
95
+ Dim refata As Variant
96
+
97
+
98
+
99
+ rfdata = Workbooks(filename).Worksheets("説明").Range(s)
100
+
101
+ k = 1
102
+
103
+
104
+
105
+ ReDim rfdata2(1 To this_line, 1) As Variant
106
+
107
+ For i = 1 To UBound(rfdata, 1)
108
+
109
+ If WorksheetFunction.IsText(rfdata(i, 1)) Then
110
+
111
+ rfdata2(k, 1) = rfdata(i, 1)
112
+
113
+ k = k + 1
114
+
115
+ End If
116
+
117
+ Next i
118
+
119
+
120
+
121
+
122
+
123
+ Application.ScreenUpdating = False
124
+
125
+ Lavel2:
126
+
127
+ Do While UBound(rfdata2, 1) > o
128
+
129
+
130
+
131
+ ThisWorkbook.Activate
132
+
133
+
134
+
135
+ If rfdata2(o, 1) Like target Then
136
+
137
+
138
+
139
+ neko(1) = 1
140
+
141
+
142
+
143
+ Exit Do
144
+
145
+
146
+
147
+ Else
148
+
149
+
150
+
151
+ o = o + 1
152
+
153
+ End If
154
+
155
+ neko(1) = 2
156
+
157
+ GoTo Lavel2
158
+
159
+ Loop
160
+
161
+ Workbooks(filename).Close
162
+
163
+ tes = neko
164
+
165
+
166
+
167
+
168
+
169
+ Application.ScreenUpdating = True
170
+
171
+ End Function
172
+
71
173
  ```