|
こんにちは。かみちゃん です。
>>データの状態が最初と変わってますけど・・・。
>すいません。書き忘れました。
>おっしゃる通りです。反省します。
ここに回答しようとしている人の気持ちも考えてください。
私の場合は、自分の勉強のためにもあるのですが、それなりに労力と時間をかけています。
それを「忘れていた」で片付けられたのでは、たまったものではないです。
と、小言は、これくらいにして、「訂正後!」の要件であれば、やはり最初に提示したURLのコードをアレンジして作ってみました。
完璧に要件にはまっているわけではないですが、ある程度できるはずです。(もちろん、動作確認すみです。)
Option Explicit
Sub MyCount2()
Dim Sn As String
Dim ColumnNo As Integer, MaxColumnNo As Integer
Dim CountRange As Range
Sn = ActiveSheet.Name & "!"
Rows(1).Insert xlShiftDown
MaxColumnNo = Range("A2").CurrentRegion.Columns.Count
With Sheets("Sheet3")
For ColumnNo = 1 To MaxColumnNo
Cells(1, ColumnNo).Value = "Data_Count"
Range(Cells(1, ColumnNo), Cells(65536, ColumnNo).End(xlUp)) _
.AdvancedFilter xlFilterCopy, , .Range("A65536").End(xlUp).Offset(1, 0), True
Set CountRange = .Range("B65536").End(xlUp)
With .Range(CountRange.Offset(1, 0), .Range("A65536").End(xlUp).Offset(, 1))
.Formula = "=COUNTIF(" & Sn & Columns(ColumnNo).Address & "," & CountRange.Offset(1, -1).Address(RowAbsolute:=False) & ")"
' .Value = .Value
End With
Next
Rows(1).Delete xlShiftUp
.Activate
Rows(1).Delete xlShiftUp
End With
With Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:="Data_Count"
.SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
.AutoFilter Field:=1
.AutoFilter
End With
Range("A1").Select
End Sub
あえて、説明はしません。
ヘルプなり、過去ログなり、検索してわからないところは調べてください。
そうすると、回答しようとしている人たちがどれくらい苦労しているかの気持ちがわかると思います。
かなり厳しいことを言いましたが、さゆりンさんのためです。
そして、回答しているのは、私の勉強のためです。
これに懲りずに、また質問してください。
そのときは、要件(「私はこのようにしたい!」)というのを忘れずにしっかりと書きましょう!
|
|