Andy2483

¦^´_ 1# hcm19522


    ÁÂÁ«e½ú¤À¨É¦¹¥DÃD,«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú­Ì«ü±Ð

°õ¦æ«e:

¤U¸ü (79.92 KB)

4 ¤p®É«e

°õ¦æµ²ªG:

¤U¸ü (82.68 KB)

4 ¤p®É«e

Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 1000, 1 To 2), K, Z, i&, j%, N&
Set Z = CreateObject("Scripting.Dictionary")
Brr = [A1:AB1].Resize(ActiveSheet.UsedRange.Rows.Count)
For j = 1 To UBound(Brr, 2)
   For i = 1 To UBound(Brr)
      If IsNumeric(Brr(i, j)) And Brr(i, j) <> "" Then Z(j) = Z(j) + 1
   Next
Next
For Each K In Z.Keys
   N = N + 1
   Crr(N, 1) = Split(Cells(1, K).Address, "$")(1)
   Crr(N, 2) = Z(K)
Next
If N > 0 Then [AD2].Resize(N, 2) = Crr
End Sub