【已解决】数据源表中D列的关键字，把C列中的数据写入过度表中，不同关键安的写入

LMY123 · 发表于 2017-6-12 19:50

本帖最后由 LMY123 于 2017-6-13 07:34 编辑

yayahzmeng · 发表于 2017-6-12 21:36

老兄，太高深了

qingc0221 · 发表于 2017-6-12 21:42

我也看不懂

yayahzmeng · 发表于 2017-6-12 22:16

看一下是不是你想要的

复制代码

LMY123 · 发表于 2017-6-12 22:51

yayahzmeng 发表于 2017-6-12 22:16
看一下是不是你想要的

感谢帮助，明天有花当补上，我没表达清楚，数据连续只是为了方便校对

612.rar (25.59 KB, 下载次数: 2)

yayahzmeng · 发表于 2017-6-12 22:58

本帖最后由 yayahzmeng 于 2017-6-13 00:04 编辑

根据新附件，并简化一下代码：

Sub tst()
arr = Range("A1:F" & [b65536].End(3).Row)
Set d = CreateObject("scripting.dictionary")
Dim crr()
For Each Rng In Range("F2:F" & [F65536].End(3).Row)
For i = 2 To UBound(arr)
If InStr(arr(i, 4), Rng.Text) > 0 Then
d(Rng.Text) = d(Rng.Text) + 1
n = Application.Ceiling(d(Rng.Text) / 76, 1)
ReDim Preserve crr(1 To 76, 1 To n)
crr(d(Rng.Text) - (n - 1) * 76, n) = arr(i, 3)
End If
Next
If Sheet9.[a1].CurrentRegion.Columns.Count = 1 Then m = 1 Else: m = Sheet9.[a1].End(2).Column + 1
Sheet9.Cells(1, m).Resize(76, n) = crr
Erase crr
Next
End Sub

复制代码

today0427 · 发表于 2017-6-12 23:17

本帖最后由 today0427 于 2017-6-12 23:25 编辑

请查看附件，结果显示在结果表中

yayahzmeng · 发表于 2017-6-12 23:58

本帖最后由 yayahzmeng 于 2017-6-13 00:06 编辑

新附件，请测试

LMY123 · 发表于 2017-6-13 07:32

today0427 发表于 2017-6-12 23:17
请查看附件，结果显示在结果表中

感谢帮助，效果非常好，有花当补上

LMY123 · 发表于 2017-6-13 07:33

yayahzmeng 发表于 2017-6-12 23:58
新附件，请测试

感谢帮助，效果非常好，有花当补上

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

[求助] 【已解决】数据源表中D列的关键字，把C列中的数据写入过度表中，不同关键安的写入