excel vba翻译？

Question

各位大佬请问谁能帮我翻译讲解下这段代码吗
Sub 制小表()
Dim d As Object
Dim ss$, n%
Range("A2:H" & [a65536].End(3).Row).Delete Shift:=xlUp
m = Sheet1.[d65536].End(xlUp).Row
arr = Sheet1.Range("d1:h" & m)
Set d = CreateObject("scripting.dictionary")
ReDim brr(1 To UBound(arr), 1 To 4)

For i = 2 To UBound(arr)
ss = arr(i, 1)
If Not d.Exists(ss) Then
n = n + 1
d.Add ss, n
brr(n, 1) = arr(i, 1): brr(n, 2) = 1: brr(n, 3) = arr(i, 4): brr(n, 4) = arr(i, 5)
Else
brr(d(ss), 2) = brr(d(ss), 2) + 1
brr(d(ss), 3) = brr(d(ss), 3) & "|" & arr(i, 4)
brr(d(ss), 4) = brr(d(ss), 4) & "|" & arr(i, 5)
End If
Next

bt = [{"序号","","","数量","码段","无码段","码段不清","户数"}]
Columns("B:C").NumberFormatLocal = "@"
d.RemoveAll
ReDim crr(1 To (m - 1) + n * 3, 1 To 8)
hs = 0
For i = 1 To n
For j = 1 To 8
crr(1 + hs, j) = bt(j)
Next
crr(1 + hs, 2) = brr(i, 1)
p1 = Split(brr(i, 3), "|")
p2 = Split(brr(i, 4), "|")
For j = 1 To brr(i, 2)
crr(j + 1 + hs, 1) = j
crr(j + 1 + hs, 2) = p1(j - 1)
crr(j + 1 + hs, 3) = p2(j - 1)

ss = Right(crr(j + 1 + hs, 3), 6)
If InStr(ss, "*") = 0 Then
If Not d.Exists(ss) Then
d.Add ss, ""
crr(j + 1 + hs, 8) = 1
crr(brr(i, 2) + 2 + hs, 8) = crr(brr(i, 2) + 2 + hs, 8) + 1
End If
End If

If InStr(crr(j + 1 + hs, 2) & crr(j + 1 + hs, 3), "*") = 0 Then
crr(j + 1 + hs, 5) = 1
crr(brr(i, 2) + 2 + hs, 5) = crr(brr(i, 2) + 2 + hs, 5) + 1
Else
If Len(Replace(crr(j + 1 + hs, 2) & crr(j + 1 + hs, 3), "*", "")) = 0 Then
crr(j + 1 + hs, 6) = 1
crr(brr(i, 2) + 2 + hs, 6) = crr(brr(i, 2) + 2 + hs, 6) + 1
Else
crr(j + 1 + hs, 7) = 1
crr(brr(i, 2) + 2 + hs, 7) = crr(brr(i, 2) + 2 + hs, 7) + 1
End If
End If
crr(j + 1 + hs, 4) = 1
crr(brr(i, 2) + 2 + hs, 4) = crr(brr(i, 2) + 2 + hs, 4) + 1
Next
crr(brr(i, 2) + 2 + hs, 1) = "合计"
crr(brr(i, 2) + 3 + hs, 1) = "备注：卷烟" & crr(brr(i, 2) + 2 + hs, 4) & "条，码段" & crr(brr(i, 2) + 2 + hs, 5) * 1 & "条，无码段" & crr(brr(i, 2) + 2 + hs, 6) * 1 & "条，码段不清" & crr(brr(i, 2) + 2 + hs, 7) * 1 & "条，涉及户数" & crr(brr(i, 2) + 2 + hs, 8) * 1 & "户"

d.RemoveAll

Cells(1, "a").Offset(brr(i, 2) + 1 + hs, 0).Resize(1, 3).Merge
Cells(1, "a").End(3).Offset(brr(i, 2) + 2 + hs, 0).Resize(1, 8).Merge
Cells(1, "a").End(3).Resize(1, 2).Offset(hs, 1).Merge
hs = hs + brr(i, 2) + 3
Next
Cells(1, "a").Resize(UBound(crr), 8) = crr
Range("a1:h" & [a65536].End(3).Row).Borders.LineStyle = 1

End Sub

Answer 1

Sub 制小表()
Dim d As Object '声明变量
Dim ss$, n% '声明变量
Range("A2:H" & [a65536].End(3).Row).Delete Shift:=xlUp '删除A2至A列最后一个非空单元格，到h列的区域，下方单元格上移
m = Sheet1.[d65536].End(xlUp).Row '获取Sheet1d列最后一个非空单元格行号
arr = Sheet1.Range("d1:h" & m) '将Sheet1d到h列数据读入数组arr
Set d = CreateObject("scripting.dictionary") '创建字典
ReDim brr(1 To UBound(arr), 1 To 4) '创建二维数组brr

For i = 2 To UBound(arr) '这个循环的作用是将arr首列相同的数据合并后放入brr
ss = arr(i, 1)
If Not d.Exists(ss) Then
n = n + 1
d.Add ss, n
brr(n, 1) = arr(i, 1): brr(n, 2) = 1: brr(n, 3) = arr(i, 4): brr(n, 4) = arr(i, 5)
Else
brr(d(ss), 2) = brr(d(ss), 2) + 1
brr(d(ss), 3) = brr(d(ss), 3) & "|" & arr(i, 4)
brr(d(ss), 4) = brr(d(ss), 4) & "|" & arr(i, 5)
End If
Next

bt = [{"序号","","","数量","码段","无码段","码段不清","户数"}] '初始化数组bt
Columns("B:C").NumberFormatLocal = "@" '设置bc列为文本格式
d.RemoveAll '清除字典
ReDim crr(1 To (m - 1) + n * 3, 1 To 8) '创建二维数组crr
hs = 0
For i = 1 To n '这个循环为brr里的每行数据制一个表
For j = 1 To 8 '这个循环初始化表头
crr(1 + hs, j) = bt(j)
Next
crr(1 + hs, 2) = brr(i, 1) '原表D列放到表头第2列
p1 = Split(brr(i, 3), "|") '拆分
p2 = Split(brr(i, 4), "|") '拆分
For j = 1 To brr(i, 2) '这个循环将brr合并的一行数据，重新拆分成原来的行数存入crr
crr(j + 1 + hs, 1) = j '第一列为序号
crr(j + 1 + hs, 2) = p1(j - 1) '第2列为原表G列
crr(j + 1 + hs, 3) = p2(j - 1) '第3列为原表H列

ss = Right(crr(j + 1 + hs, 3), 6) '取原表H列数据右边6位，没有“*”且不重复的在第8列进行计数
If InStr(ss, "*") = 0 Then
If Not d.Exists(ss) Then
d.Add ss, ""
crr(j + 1 + hs, 8) = 1
crr(brr(i, 2) + 2 + hs, 8) = crr(brr(i, 2) + 2 + hs, 8) + 1
End If
End If

If InStr(crr(j + 1 + hs, 2) & crr(j + 1 + hs, 3), "*") = 0 Then '原表G、H列数据，没有“*”在第5列进行计数，全是“*”在第6列进行计数，其余在第7列进行计数
crr(j + 1 + hs, 5) = 1
crr(brr(i, 2) + 2 + hs, 5) = crr(brr(i, 2) + 2 + hs, 5) + 1
Else
If Len(Replace(crr(j + 1 + hs, 2) & crr(j + 1 + hs, 3), "*", "")) = 0 Then
crr(j + 1 + hs, 6) = 1
crr(brr(i, 2) + 2 + hs, 6) = crr(brr(i, 2) + 2 + hs, 6) + 1
Else
crr(j + 1 + hs, 7) = 1
crr(brr(i, 2) + 2 + hs, 7) = crr(brr(i, 2) + 2 + hs, 7) + 1
End If
End If
crr(j + 1 + hs, 4) = 1
crr(brr(i, 2) + 2 + hs, 4) = crr(brr(i, 2) + 2 + hs, 4) + 1
Next
crr(brr(i, 2) + 2 + hs, 1) = "合计"
crr(brr(i, 2) + 3 + hs, 1) = "备注：卷烟" & crr(brr(i, 2) + 2 + hs, 4) & "条，码段" & crr(brr(i, 2) + 2 + hs, 5) * 1 & "条，无码段" & crr(brr(i, 2) + 2 + hs, 6) * 1 & "条，码段不清" & crr(brr(i, 2) + 2 + hs, 7) * 1 & "条，涉及户数" & crr(brr(i, 2) + 2 + hs, 8) * 1 & "户"

d.RemoveAll

Cells(1, "a").Offset(brr(i, 2) + 1 + hs, 0).Resize(1, 3).Merge '合并单元格，每表倒数第二行前三列
Cells(1, "a").End(3).Offset(brr(i, 2) + 2 + hs, 0).Resize(1, 8).Merge '合并单元格，每表最后一行8列
Cells(1, "a").End(3).Resize(1, 2).Offset(hs, 1).Merge '合并单元格，表头2，3列，另外本行与上一行代码End(3).多余，有没有效果一样，但是加上后影响运算速度
hs = hs + brr(i, 2) + 3 '表格总行数
Next
Cells(1, "a").Resize(UBound(crr), 8) = crr '将crr数据写入单元格
Range("a1:h" & [a65536].End(3).Row).Borders.LineStyle = 1 '设置边框

End Sub