统计每个字母对应的全部数字

Nsp=娜！再来#

已解决，答案在4楼和2楼，感谢老师们的帮助！
求教：
1.提取B2：B1048576列的第一个英文到H2:H1048576列;
2.H列每个字母对应G列单元格中的全部数字，统计每个字母对应的全部数字，结果显示在P2单元格。
求教.zip (65.09 KB, 下载次数: 26)

2020-2-17 13:42 上传

点击文件名下载附件

一把小刀闯天下

'可能是这意思。为了方便输出数字位置调整了一下，，，

Option Explicit

Sub test()
  Dim arr, i As Long, j As Long, m As Long, n As Long, s As String
  arr = Range("c2:g" & Cells(Rows.Count, "c").End(xlUp).Row).Value
  ReDim brr(9, 1 To 26)
  For i = 1 To UBound(arr, 1)
    s = Left(arr(i, 1), 1): n = Asc(s) - 64
    arr(i, 1) = s
    For j = 1 To Len(arr(i, 5))
      m = Mid(arr(i, 5), j, 1)
      brr(m, n) = brr(m, n) + 1
    Next
  Next
  [h2].Resize(UBound(arr, 1)) = arr
  [p2].Resize(UBound(brr, 1) + 1, UBound(brr, 2)) = brr
  For i = 16 To 16 + 26 - 1
    Cells(1, i) = Chr(i + 49)
  Next
  For i = 2 To 2 + 10 - 1
    Cells(i, "o") = i - 2
  Next
End Sub

jnsxmt

是否如你所愿，请审阅

lsdongjh

1. Sub 求教()
   
2.     Dim sh As Worksheet, lngRow As Long, lngCol As Long, arrData As Variant
   
3.     Dim arrChar As Variant, arrResult As Variant
   
4.     Dim strChars As String, strNums As String
   
5.     Dim bytChar() As Byte, lngID As Long
   
6.     Dim RowID As Long, ColID As Long
   
7.         
   
8.     Set sh = Sheets("Sheet1")
   
9.     lngRow = sh.Range("C" & Rows.Count).End(xlUp).Row
   
10.    
    
11.     arrData = sh.Range("C2:G" & lngRow)
    
12.     ReDim arrChar(1 To UBound(arrData), 1 To 1) As String
    
13.     ReDim arrResult(1 To 10, 1 To 10) As Integer '1-10 行，A-J列
    
14.    
    
15.     For lngRow = 1 To UBound(arrData)
    
16.         strChars = StrConv(Trim(arrData(lngRow, 1)), vbFromUnicode) 'C列 B区
    
17.         strNums = StrConv(Trim(arrData(lngRow, 5)), vbFromUnicode)  'G列 数字
    
18.         
    
19.         bytChar = strChars
    
20.         lngID = bytChar(0): ColID = lngID - 64
    
21.         arrChar(lngRow, 1) = Chr(lngID)
    
22.         
    
23.         bytChar = strNums
    
24.         For lngCol = LBound(bytChar) To UBound(bytChar)
    
25.             lngID = bytChar(lngCol): RowID = lngID - 48
    
26.             If RowID = 0 Then RowID = 10
    
27.             arrResult(RowID, ColID) = arrResult(RowID, ColID) + 1
    
28.         Next
    
29.     Next
    
30.    
    
31.     sh.Range("H2").Resize(UBound(arrChar), 1) = arrChar
    
32.    
    
33.     sh.Range("P1").Resize(1, 10) = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
    
34.     sh.Range("O2").Resize(10, 1) = Application.WorksheetFunction.Transpose(Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0))
    
35.     sh.Range("P2").Resize(10, 10) = arrResult
    
36. End Sub
    

复制代码

Nsp=娜！再来#

一把小刀闯天下 发表于 2020-2-17 14:06
'可能是这意思。为了方便输出数字位置调整了一下，，，

Option Explicit

谢谢老师，生成的结果全部正确。

xiaoqiang17

试做，请参考。

micch

1. Sub test()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Range([c2], [g2].End(4))
   
4.         For i = 1 To UBound(arr)
   
5.             For k = 1 To 5
   
6.                 d(Left(arr(i, 1), 1) & Mid(arr(i, 5), k, 1)) = 1 + d(Left(arr(i, 1), 1) & Mid(arr(i, 5), k, 1))
   
7.         Next k, i
   
8.     arr = [o1:y11]
   
9.         For i = 2 To 11
   
10.             For k = 2 To 11
    
11.                 arr(i, k) = d(arr(1, k) & arr(i, 1))
    
12.         Next k, i
    
13.     [o1:y11] = arr
    
14. End Sub
    

复制代码