VBA - CONCATENATE + VLOOKUP with Scripting Dictionary

Question

我正在尝试创建一个我每月创建的报告的宏。我已经做了近两个星期了。我被卡住了.Below是我的电子表格。 “data”表是我的源数据，“new_table”是我需要的标准化表。为了规范化数据，我创建了列类别，它是user_id和question_id的连接。

请注意 *我使用400K行，因此我试图用脚本字典vlookup实现它 *我需要在“new_table”中连接行和列以获得与答案匹配的类别 *我从“数据”中的类别复制唯一单元格并转置为“new_table”第1行以使其成为标题

表（“数据”） user_id问题ID类别答案 user1 ques1 user1ques1 yes user2 ques1 user2ques1 no user1 ques2 user1ques2 yes

Sheet（“new_table”） user_id user1ques1 user2ques1 user1ques2 user1是N / A是 user2 N / A no N / A

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

到目前为止，我所拥有的并不多。我仍然坚持尝试编写vlookup我已经研究了“new_table”中可能不同的列号的连接和动态。请帮忙

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

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

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