|
こんにちは。かみちゃん です。
>列ごとに1が何個あって2が何個あって3が何個あってとそれぞれマクロでカウントし、Sheet3に結果を貼り付けたいのですが、どうしたらよいでしょうか?
さきほどご提示したURLとは、まったく違う方法です。
セルの値を1つずつループして検査しますので、処理速度は保証できません。
Option Explicit
Sub Macro1()
Dim flg As Integer
Dim c As Range, c2 As Range
flg = 0
'結果出力シートを全消去する
Sheets("Sheet3").Cells.ClearContents
'Sheet1のA1から空白行空白列で囲まれたセル範囲すべてを検査する。
For Each c In Sheets("Sheet1").Range("A1").CurrentRegion
'セルの値が空白のときは、カウントしない
If c.Value <> "" Then
With Sheets("Sheet3").Columns("A")
Set c2 = .Find(c.Value, LookIn:=xlValues)
If Not c2 Is Nothing Then
c2.Offset(0, 1).Value = c2.Offset(0, 1).Value + 1
Else
With .Range("A65536").End(xlUp)
.Offset(1 * flg, 0).Value = c.Value
.Offset(1 * flg, 1).Value = 1
End With
flg = 1
End If
End With
End If
Next
End Sub
|
|