teratail
回答率
85.35%
teratail header banner
teratail header banner
質問するログイン新規登録
トップVBAに関する質問カウントした行数の内容をMsgBoxに表示したい（VBA）

編集履歴

回答編集履歴

4

簡略化

2021/12/13 06:24

投稿

bebebe_
bebebe_

スコア513

test CHANGED
@@ -54,10 +54,6 @@
54
54
 
55
55
  Dim number As Variant
56
56
 
57
- Dim count As Variant
58
-
59
- Dim i As Long
60
-
61
57
 
62
58
 
63
59
  Set dicT = CreateObject("Scripting.Dictionary")
@@ -88,27 +84,19 @@
88
84
 
89
85
  Next
90
86
 
91
-
92
-
93
- number = dicT.keys
94
-
95
- count = dicT.items
96
87
 
97
88
 
89
+ For Each number In dicT.keys
98
90
 
99
- For i = 0 To UBound(dicT.items)
91
+ If dicT.Item(number) > 1 Then
100
92
 
101
- If count(i) > 1 Then
102
-
103
- tempStr = tempStr & number(i) & "：" & count(i) & vbCrLf
93
+ tempStr = tempStr & number & "：" & dicT.Item(number) & vbCrLf
104
94
 
105
95
  End If
106
96
 
107
- Next i
97
+ Next number
108
98
 
109
99
 
110
-
111
- '結果の表示
112
100
 
113
101
  MsgBox tempStr
114
102
 

3

簡略化

2021/12/13 06:24

投稿

bebebe_
bebebe_

スコア513

test CHANGED
@@ -50,8 +50,6 @@
50
50
 
51
51
 
52
52
 
53
- Dim dicTCount As Object
54
-
55
53
  Dim tempStr As String
56
54
 
57
55
  Dim number As Variant
@@ -60,15 +58,9 @@
60
58
 
61
59
  Dim i As Long
62
60
 
63
-
64
-
65
- count1 = 0
66
-
67
61
 
68
62
 
69
63
  Set dicT = CreateObject("Scripting.Dictionary")
70
-
71
- Set dicTCount = CreateObject("Scripting.Dictionary")
72
64
 
73
65
 
74
66
 
@@ -90,15 +82,7 @@
90
82
 
91
83
  Else
92
84
 
93
- If dicTCount.Exists(key) = False Then
94
-
95
- dicTCount.Add key, 2
96
-
97
- Else
98
-
99
- dicTCount(key) = dicTCount(key) + 1
85
+ dicT(key) = dicT(key) + 1
100
-
101
- End If
102
86
 
103
87
  End If
104
88
 
@@ -106,15 +90,19 @@
106
90
 
107
91
 
108
92
 
109
- number = dicTCount.keys
93
+ number = dicT.keys
110
94
 
111
- count = dicTCount.items
95
+ count = dicT.items
112
96
 
113
97
 
114
98
 
115
- For i = 0 To UBound(dicTCount.items)
99
+ For i = 0 To UBound(dicT.items)
116
100
 
101
+ If count(i) > 1 Then
102
+
117
- tempStr = tempStr & number(i) & "：" & count(i) & vbCrLf
103
+ tempStr = tempStr & number(i) & "：" & count(i) & vbCrLf
104
+
105
+ End If
118
106
 
119
107
  Next i
120
108
 

2

不要部分削除

2021/12/13 04:58

投稿

bebebe_
bebebe_

スコア513

test CHANGED
@@ -47,8 +47,6 @@
47
47
  Dim dicT As Object
48
48
 
49
49
  Dim key As String
50
-
51
- Dim count1 As Long
52
50
 
53
51
 
54
52
 

1

追記分

2021/12/13 04:40

投稿

bebebe_
bebebe_

スコア513

test CHANGED
@@ -27,3 +27,107 @@
27
27
  MsgBox "作成が完了しました。" & vbCrLf & vbCrLf & "回答数：" & Count & vbCrLf & tempStr
28
28
 
29
29
  ```
30
+
31
+
32
+
33
+ 追記用
34
+
35
+ ```VBA
36
+
37
+ Sub 回答者の重複をカウント()
38
+
39
+
40
+
41
+ Dim sh1 As Worksheet
42
+
43
+ Dim maxrow As Long
44
+
45
+ Dim wrow As Long
46
+
47
+ Dim dicT As Object
48
+
49
+ Dim key As String
50
+
51
+ Dim count1 As Long
52
+
53
+
54
+
55
+ Dim dicTCount As Object
56
+
57
+ Dim tempStr As String
58
+
59
+ Dim number As Variant
60
+
61
+ Dim count As Variant
62
+
63
+ Dim i As Long
64
+
65
+
66
+
67
+ count1 = 0
68
+
69
+
70
+
71
+ Set dicT = CreateObject("Scripting.Dictionary")
72
+
73
+ Set dicTCount = CreateObject("Scripting.Dictionary")
74
+
75
+
76
+
77
+ Set sh1 = Worksheets("rawdata")
78
+
79
+ maxrow = sh1.Cells(Rows.count, "B").End(xlUp).Row
80
+
81
+
82
+
83
+ For wrow = 2 To maxrow
84
+
85
+ key = sh1.Cells(wrow, "B").Value
86
+
87
+
88
+
89
+ If dicT.Exists(key) = False Then
90
+
91
+ dicT.Add key, 1
92
+
93
+ Else
94
+
95
+ If dicTCount.Exists(key) = False Then
96
+
97
+ dicTCount.Add key, 2
98
+
99
+ Else
100
+
101
+ dicTCount(key) = dicTCount(key) + 1
102
+
103
+ End If
104
+
105
+ End If
106
+
107
+ Next
108
+
109
+
110
+
111
+ number = dicTCount.keys
112
+
113
+ count = dicTCount.items
114
+
115
+
116
+
117
+ For i = 0 To UBound(dicTCount.items)
118
+
119
+ tempStr = tempStr & number(i) & "：" & count(i) & vbCrLf
120
+
121
+ Next i
122
+
123
+
124
+
125
+ '結果の表示
126
+
127
+ MsgBox tempStr
128
+
129
+
130
+
131
+ End Sub
132
+
133
+ ```