用VBA统计每行后2位数的个数自动制表

excelnew1

统计每行后2位数的个数自动制表。

苏小亓

统计每行后2位数的个数自动制表.zip (16.91 KB, 下载次数: 9)

2018-8-27 10:14 上传

点击文件名下载附件

excelnew1

苏小亓 发表于 2018-8-27 10:14

老师解答速度好快， 可否发一下代码，附件里没有代码。且没有的显示为空，不显示0.

xiangbaoan

……………仅供参考……………

xiangbaoan

xiangbaoan 发表于 2018-8-27 10:39
……………仅供参考……………

Sub test()
Dim ar, br(), r&, c%
ar = [e14].CurrentRegion
ReDim br(UBound(ar), 99)
For c = 0 To 99
    br(0, c) = c
Next
For r = 1 To UBound(ar)
    For c = 1 To UBound(ar, 2)
        n = Val(Right(ar(r, c), 2))
        br(r, n) = br(r, n) + 1
    Next
Next
[e25].Resize(1, 100).NumberFormatLocal = "00"
[e25].Resize(r, 100) = br
End Sub

lsdongjh

1. Sub Test()
   
2.     Dim SH As Worksheet
   
3.     Dim arrSource As Variant
   
4.     Dim arrResult As Variant
   
5.     Dim lngRow As Long, lngCol As Long
   
6.     Dim intVal As Integer
   
7.    
   
8.     Set SH = Sheets("Sheet1")
   
9.     arrSource = SH.Range("E14:DA21")
   
10.     ReDim arrResult(0 To UBound(arrSource), 0 To 99)
    
11.    
    
12.     For intVal = 0 To 99
    
13.         arrResult(0, intVal) = Format(intVal, "00")
    
14.     Next
    
15.    
    
16.     For lngRow = LBound(arrSource) To UBound(arrSource)
    
17.         For lngCol = LBound(arrSource, 2) To UBound(arrSource, 2)
    
18.             intVal = Val(Right(arrSource(lngRow, lngCol), 2))
    
19.             arrResult(lngRow, intVal) = Val(arrResult(lngRow, intVal)) + 1
    
20.         Next
    
21.     Next
    
22.    
    
23.     SH.Range("E25:DA" & Rows.Count).ClearContents
    
24.     SH.Range("E25").Resize(UBound(arrResult) + 1, 100) = arrResult
    
25. End Sub

复制代码

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, sum, i, j
  arr = [E14].CurrentRegion.Value
  ReDim sum(1 To UBound(arr, 1), 99)
  For i = 1 To UBound(arr, 1)
    For j = 1 To UBound(arr, 2)
      sum(i, Val(Right(arr(i, j), 2))) = sum(i, Val(Right(arr(i, j), 2))) + 1
  Next j, i
  [e26].Resize(UBound(sum, 1), UBound(sum, 2) + 1) = sum
End Sub