teratail
回答率
85.37%
teratail 10th-anniversary
teratail 10th-anniversary
質問するログイン新規登録
トップVBAに関する質問VBA セルに特定の条件で番号を付与したい

編集履歴

回答編集履歴

5

修正

2021/08/29 06:26

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -12,17 +12,13 @@
12
12
 
13
13
  lastrow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
14
14
 
15
- Dim flg As Boolean
16
-
17
15
  Dim i, torikomi
18
16
 
19
17
  For i = 3 To lastrow
20
18
 
21
19
  If ws.Cells(i, 2) & vbTab & ws.Cells(i, 3) <> ws.Cells(i - 1, 2) & vbTab & ws.Cells(i - 1, 3) Then
22
20
 
23
- flg = WorksheetFunction.SumIfs(ws.Columns(8), ws.Columns(2), ws.Cells(i, 2), ws.Columns(3), ws.Cells(i, 3)) > 0
21
+ If WorksheetFunction.SumIfs(ws.Columns(8), ws.Columns(2), ws.Cells(i, 2), ws.Columns(3), ws.Cells(i, 3)) > 0 Then torikomi = torikomi + 1
24
-
25
- If flg Then torikomi = torikomi + 1
26
22
 
27
23
  End If
28
24
 

4

修正

2021/08/29 06:26

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -1,4 +1,4 @@
1
- コメントを受け、少し修正しました。こんな感じでどうでしょうか。
1
+ コメントを受け、再度修正しました。こんな感じでどうでしょうか。
2
2
 
3
3
  ```vba
4
4
 
@@ -18,7 +18,7 @@
18
18
 
19
19
  For i = 3 To lastrow
20
20
 
21
- If ws.Cells(i, 2) & vbTab & ws.Cells(i, 3) <> ws.Cells(i - 1, 2) & vbTab & ws.Cells(i - 1, 3) Then
21
+ If ws.Cells(i, 2) & vbTab & ws.Cells(i, 3) <> ws.Cells(i - 1, 2) & vbTab & ws.Cells(i - 1, 3) Then
22
22
 
23
23
  flg = WorksheetFunction.SumIfs(ws.Columns(8), ws.Columns(2), ws.Cells(i, 2), ws.Columns(3), ws.Cells(i, 3)) > 0
24
24
 
@@ -26,14 +26,12 @@
26
26
 
27
27
  End If
28
28
 
29
- ws.Cells(i, 1) = IIf(flg, torikomi, "")
29
+ ws.Cells(i, 1) = IIf(ws.Cells(i, 8) > 0, torikomi, "")
30
30
 
31
31
  Next
32
32
 
33
33
  End Sub
34
34
 
35
-
36
-
37
35
  ```
38
36
 
39
37
  ---

3

修正

2021/08/29 06:24

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -1,42 +1,4 @@
1
- こんな感じでどうでしょうか。（修正しました。）
1
+ コメントを受け、少し修正しました。こんな感じでどうでしょうか。
2
-
3
- ```VBA
4
-
5
- Sub sample()
6
-
7
- Dim ws As Worksheet
8
-
9
- Set ws = Worksheets("Sheet1")
10
-
11
- Dim lastrow
12
-
13
- lastrow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
14
-
15
- Dim i, torikomi
16
-
17
- For i = 3 To lastrow
18
-
19
- If WorksheetFunction.SumIfs(ws.Columns(8), ws.Columns(2), ws.Cells(i, 2), ws.Columns(3), ws.Cells(i, 3)) > 0 Then
20
-
21
- If ws.Cells(i, 2) = ws.Cells(i - 1, 2) And ws.Cells(i, 3) = ws.Cells(i - 1, 3) Then
22
-
23
- Else
24
-
25
- torikomi = torikomi + 1
26
-
27
- End If
28
-
29
- ws.Cells(i, 1) = torikomi
30
-
31
- End If
32
-
33
- Next
34
-
35
- End Sub
36
-
37
- ```
38
-
39
- ---
40
2
 
41
3
  ```vba
42
4
 

2

add

2021/08/29 03:38

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -35,3 +35,43 @@
35
35
  End Sub
36
36
 
37
37
  ```
38
+
39
+ ---
40
+
41
+ ```vba
42
+
43
+ Sub sample()
44
+
45
+ Dim ws As Worksheet
46
+
47
+ Set ws = Worksheets("Sheet1")
48
+
49
+ Dim lastrow
50
+
51
+ lastrow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
52
+
53
+ Dim flg As Boolean
54
+
55
+ Dim i, torikomi
56
+
57
+ For i = 3 To lastrow
58
+
59
+ If ws.Cells(i, 2) & vbTab & ws.Cells(i, 3) <> ws.Cells(i - 1, 2) & vbTab & ws.Cells(i - 1, 3) Then
60
+
61
+ flg = WorksheetFunction.SumIfs(ws.Columns(8), ws.Columns(2), ws.Cells(i, 2), ws.Columns(3), ws.Cells(i, 3)) > 0
62
+
63
+ If flg Then torikomi = torikomi + 1
64
+
65
+ End If
66
+
67
+ ws.Cells(i, 1) = IIf(flg, torikomi, "")
68
+
69
+ Next
70
+
71
+ End Sub
72
+
73
+
74
+
75
+ ```
76
+
77
+ ---

1

修正

2021/08/27 15:15

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -1,4 +1,4 @@
1
- こんな感じでどうでしょうか。
1
+ こんな感じでどうでしょうか。（修正しました。）
2
2
 
3
3
  ```VBA
4
4
 
@@ -16,17 +16,17 @@
16
16
 
17
17
  For i = 3 To lastrow
18
18
 
19
- If ws.Cells(i, 2) = ws.Cells(i + 1, 2) And ws.Cells(i, 3) = ws.Cells(i + 1, 3) Then
19
+ If WorksheetFunction.SumIfs(ws.Columns(8), ws.Columns(2), ws.Cells(i, 2), ws.Columns(3), ws.Cells(i, 3)) > 0 Then
20
20
 
21
- Else
21
+ If ws.Cells(i, 2) = ws.Cells(i - 1, 2) And ws.Cells(i, 3) = ws.Cells(i - 1, 3) Then
22
22
 
23
- If WorksheetFunction.SumIfs(ws.Columns(8), ws.Columns(2), ws.Cells(i, 2), ws.Columns(3), ws.Cells(i, 3)) > 0 Then
23
+ Else
24
24
 
25
25
  torikomi = torikomi + 1
26
26
 
27
- ws.Cells(i, 1) = torikomi
27
+ End If
28
28
 
29
- End If
29
+ ws.Cells(i, 1) = torikomi
30
30
 
31
31
  End If
32
32
 
@@ -34,6 +34,4 @@
34
34
 
35
35
  End Sub
36
36
 
37
-
38
-
39
37
  ```