VBA-串联+；带脚本字典的VLOOKUP

我正在尝试创建一个每月创建的报告的宏。我已经做了差不多两个星期了。我被卡住了。下面是我的电子表格。“数据”表是我的源数据，“新表”是我需要的规范化表。为了规范化数据，我创建了列category，它是user\u id和question\u id的串联

注 *我使用400K行，因此我尝试使用脚本字典vlookup来实现这一点 *我需要连接“new_table”中的行和列，以获得与答案匹配的类别 *我从“data”中的category中复制唯一的单元格，并将其转置到“new_table”第1行，使其成为标题

表（“数据”） 用户id问题id类别答案 用户1任务1用户1任务1是 用户2任务1用户2任务1否 用户1任务2用户1任务2是

表格（“新表格”） 用户id user1ques1 user2ques1 user1ques2 用户1是不适用是 用户2不适用不适用

我无法创建vba以允许我vlookup列类别，从“数据”中回答并将其与“新表”中的串联列和行匹配

这是我到目前为止所拥有的，并不多。我仍然在努力解决我在“new_table”中研究的可能不同列号的串联和动态的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

---

这是解决方案的一个组成部分。我仍然不确定您要连接哪些值。我将在评论后更新。
测试：

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