求大神帮忙！！！！！

leiyu18530 · 发表于 2015-9-10 19:46

附件里有具体要求，求大神帮忙，实在写不出来了！！！

zhouzhongchi · 发表于 2015-9-10 20:17

复制代码

leiyu18530 · 发表于 2015-9-10 20:20

zhouzhongchi 发表于 2015-9-10 20:17

555555，大神，我想用VBA写！！！

zhouzhongchi · 发表于 2015-9-10 20:38

leiyu18530 发表于 2015-9-10 20:20
555555，大神，我想用VBA写！！！

哦，愣是没看出来要求vba。
好吧，稍安勿躁。

leiyu18530 · 发表于 2015-9-10 20:42

zhouzhongchi 发表于 2015-9-10 20:38
哦，愣是没看出来要求vba。
好吧，稍安勿躁。

呵呵，谢谢大神，是我没把要求说清楚，太紧张了！

zhouzhongchi · 发表于 2015-9-10 21:52

Sub test()
Dim sht As Worksheet
arr = Sheets("sheet1").[a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
If Len(arr(i, 1)) = 5 Then
If Mid(arr(i, 1), 3, 1) > "6" Then Mid(arr(i, 1), 3, 1) = 6
Else
arr(i, 1) = Mid(arr(i, 1), 6, 5)
End If
If Not d.exists(arr(i, 1)) Then m = m + 1: d(arr(i, 1)) = m: brr(m, 1) = arr(i, 1)
For j = 2 To UBound(arr, 2)
brr(d(arr(i, 1)), j) = brr(d(arr(i, 1)), j) + arr(i, j)
Next
Next
Application.DisplayAlerts = False
For Each sht In Sheets
If sht.Name <> "Sheet1" Then sht.Delete
Next
Application.DisplayAlerts = True
For j = 2 To UBound(arr, 2) - 1
ReDim crr(1 To m, 1 To 2)
For i = 1 To m
crr(i, 1) = brr(i, 1)
crr(i, 2) = brr(i, j)
Next
Sheets.Add(after:=Sheets(Sheets.Count)).Name = arr(1, j)
With ActiveSheet
.[a1:b1] = Array("销售终端号", "销售金额")
.[a2].Resize(m, 2) = crr
End With
Next
'Stop
End Sub

复制代码

可否？？？

leiyu18530 · 发表于 2015-9-10 22:04

zhouzhongchi 发表于 2015-9-10 21:52
可否？？？

提示下标越界！我仔细研究研究谢谢老师！！！！

leiyu18530 · 发表于 2015-9-10 22:10

zhouzhongchi 发表于 2015-9-10 21:52
可否？？？

谢谢老师，幸苦了，点击复制的代码不行但是直接复制回复里可见代码好像可以，谢谢您，辛苦了！

leiyu18530 · 发表于 2015-9-10 22:43

zhouzhongchi 发表于 2015-9-10 21:52
可否？？？

55555.老师。不行呢，未定义变量。不能能提取5位编码，但不能修改第三位的 7 8 9 销量无法求和！

zhouzhongchi · 发表于 2015-9-10 22:51

leiyu18530 发表于 2015-9-10 22:43
55555.老师。不行呢，未定义变量。不能能提取5位编码，但不能修改第三位的 7 8 9 销量无法求和！

我这里可以呢？

		自动登录	找回密码
密码			免费注册