通过一题十解谈拓宽编程思路

hjgjack · 发表于 2015-3-30 11:09

牛人太多，学习了

kinkouhou · 发表于 2015-4-3 11:55

doitbest 发表于 2013-3-28 15:46
图片演示结果，AB列为数据源，DE列为结果

说实话，楼主写的代码我没看不懂（才学了3星期的VBA）
我用 for 加 if 语句，也写了个简单的代码，但效果一样。

整合.zip (24.42 KB, 下载次数: 5)

kinkouhou · 发表于 2015-4-3 11:58

lee1892 发表于 2013-4-3 23:54
按B列排序？补id？
C列干嘛的？id顺序和B列顺序相反咋办？

看我这个代码，够简单的吧

整合.zip (24.42 KB, 下载次数: 8)

zongyj · 发表于 2015-4-7 12:49

优秀作品，值得拥有

weiyingde · 发表于 2015-12-4 13:35

这样的帖子太少了，总结帖具有很大的能量，值得可定，可惜今天没分可送

terry25312135 · 发表于 2015-12-4 15:58

留个记号，以后慢慢研究

走过路过嫑错过 · 发表于 2020-4-6 23:26

向经典致敬，路过留痕

b_57 · 发表于 2020-4-7 17:12

本帖最后由 b_57 于 2020-4-7 17:20 编辑

我也写个，没测试，大致思路是这样的，应该不会错
Dim a(1 To 4)
For i = 1 To 4
a(i) = 0
Next

For i = 2 To 65536

If Range("a" & i) = "" Then Exit For

Range("e" & a(Range("A" & i) * 5 + Range("A" & i))) = Range("B" & i)
a(Range("A" & i)) = a(Range("A" & i)) + 1

Next

a_max = applicaiton.WorksheetFunction.Max(a(4))

For j = 0 To a_max

Range("D" & j * 5 + 1) = 1
Range("D" & j * 5 + 2) = 2
Range("D" & j * 5 + 3) = 3
Range("D" & j * 5 + 4) = 4
Next

还可以改成通用的不是针对1-4. 不高兴改了。

hahahahhahahah · 发表于 2020-11-18 15:31

好东西，康康

zopey · 发表于 2020-11-19 10:52

Sub 按钮1_Click()
Dim arr, k0, brr(), k, crr()
k0 = [a1].End(4).Row - 1
arr = [a2].Resize(k0, 2)
ReDim brr(1 To k0)
k = 1: brr(k) = 1
For i = 2 To k0
If arr(i, 1) <= arr(i - 1, 1) Then k = k + 1: brr(k) = i
Next
k = k + 1: brr(k) = i
ReDim Preserve brr(1 To k)
''''''''
ReDim crr(1 To k * 5, 1 To 2)
For i = 1 To k - 1
For j = 1 To 4
crr((i - 1) * 5 + j, 1) = j
Next
For j = brr(i) To brr(i + 1) - 1
crr((i - 1) * 5 + arr(j, 1), 2) = arr(j, 2)
Next
Next i
[d2].Resize(9999, 2).ClearContents
[d2].Resize(k * 5, 2) = crr
End Sub

复制代码

。。。

数组解法

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

[原创] 通过一题十解谈拓宽编程思路