VBA – CONCATENATE + VLOOKUP with Scripting Dictionary

我正在尝试创build一个每月创build的报告的macros。 我已经做了近两个星期的工作。 我卡住了。下面是我的电子表格。 “数据”表是我的源数据，“new_table”是我需要的标准化数据表。 为了规范化数据，我创build了一个与user_id和question_id连接的列类别。

注意*我使用400K行，因此我试图用脚本语言vlookup实现这一点*我需要连接“new_table”中的行和列以获得与答案匹配的类别*我从“数据“并转置到”new_table“第1行以使其成为标题

Sheet（“data”）user_id问题id类别答案user1 ques1 user1ques1 yes user2 ques1 user2ques1 no user1 ques2 user1ques2 yes

表（“new_table”）user_id user1ques1 user2ques1 user1ques2 user1是不适用是user2不适用不适用不适用

我无法创build一个vba来允许我查看列类别，从“数据”回答，并将其与来自“new_table”的连接列和行进行匹配，

这是我迄今为止没有太多的东西。 我仍然坚持试图找出在“new_table”中的可能不同的列号的连接和dynamic连接的vlookup。 请帮忙

Dim x, i&, s$ With Sheets("data") x = .Range("A2:D" & .Cells(Rows.Count, 1).End(xlUp).Row).Value End With With CreateObject("Scripting.Dictionary") .CompareMode = 1 For i = 2 To UBound(x) s = x(i, 1): .Item(s) = x(i, 3) Next i With Sheets("new_table") x = .Range("A2:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Value End With For i = 2 To UBound(x) s = x(i, 1) If .Exists(s) Then x(i, 1) = .Item(s) Else x(i, 1) = vbNullString Next i End With Sheets("new_table").Range("B2").Resize(i - 1).Value = x 

Answer 1

这是您的解决scheme的一个组成部分。 我仍然不确定你试图连接的值。 我会在评论后更新。
testing：

 Private Sub UniqueColHeaders() Dim rng As Range Dim Dn As Range Dim Dic As Object Dim colNum As Long 'Get the unique values in Category from "Data" if Category is Column C Worksheets("data").Select Set rng = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp)) Set Dic = CreateObject("scripting.dictionary") Dic.CompareMode = vbTextCompare For Each Dn In rng If Not Dn = vbNullString Then Dic(Dn.Value) = Empty Next 'Now set the column headers on "new_table" colNum = 2 For Each Item In Dic Sheets("new_table").Cells(1, colNum).Value = Item colNum = colNum + 1 Next End Sub