怎么实现A表不断录入数据，自动生成B表，客户名称是重复的

ccy311

求助  怎么实现A表不断录入数据，自动生成B表，客户名称是重复的

3190496160

Sub luru()
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheet1
    y = .Cells(4, Columns.Count).End(xlToLeft).Column
    ar = .Range(.Cells(4, 6), .Cells(10000, y))
    For j = 2 To UBound(ar, 2)
        If Trim(ar(1, j)) <> "" Then
            d(Trim(ar(1, j))) = j
        End If
    Next j
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    br = .Range("a4:b" & r)
    For i = 2 To UBound(br)
        If Trim(br(i, 1)) <> "" Then
            If Not dc.exists(Trim(br(i, 1))) Then
                dc(Trim(br(i, 1))) = br(i, 2)
            Else
                dc(Trim(br(i, 1))) = dc(Trim(br(i, 1))) & "|" & br(i, 2)
            End If
        End If
    Next i
    For Each K In dc.keys
        m = d(Trim(K))
        If m <> "" Then
            t = .Cells(Rows.Count, m + 5).End(xlUp).Row - 2
            MC = dc(K)
            rr = Split(dc(K), "|")
            For s = 0 To UBound(rr)
                ar(t, m) = rr(s)
                t = t + 1
            Next s
        End If
    Next K
     .Range(.Cells(4, 6), .Cells(10000, y)) = ar
End With
End Sub

3190496160

怎么实现A表不断录入数据，自动生成B表，客户名称是重复的.rar (16.03 KB, 下载次数: 43)

2020-7-17 09:18 上传

点击文件名下载附件

3190496160

进过几次测试，结果是正确的，你自己测试看看吧，这个问题，关键是对相应列的行数据的判断

ccy311

3190496160 发表于 2020-7-17 09:19
进过几次测试，结果是正确的，你自己测试看看吧，这个问题，关键是对相应列的行数据的判断

关键是对相应列的行数据是不断的更新的，客户名称不断的增加或产品不断的增加，怎么可以自动更新到另外一个工作簿中

3190496160

ccy311 发表于 2020-7-17 11:45
关键是对相应列的行数据是不断的更新的，客户名称不断的增加或产品不断的增加，怎么可以自动更新到另外一 ...

1、名称不断增加代码可以自己适应的，
2、代码近针对你上传的附件，不可能你不说，别人也能知道你想做什么