VBA - CONCATENATE + VLOOKUP 与脚本字典答案

【问题标题】：VBA - CONCATENATE + VLOOKUP with Scripting DictionaryVBA - CONCATENATE + VLOOKUP 与脚本字典
【发布时间】：2015-01-28 02:56:39
【问题描述】：

我正在尝试创建每月创建的报告的宏。我已经为此工作了将近两个星期。我被卡住了。下面是我的电子表格。 “数据”表是我的源数据，“new_table”是我需要的规范化表。为了规范化数据，我创建了列类别，它是 user_id 和 question_id 的串联。

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

工作表（“数据”） user_id 问题 id 类别答案用户 1 问题 1 用户 1 问题 1 是用户 2 问题 1 用户 2 问题 1 否 user1 ques2 user1ques2 是

工作表（“new_table”） user_id user1ques1 user2ques1 user1ques2 用户 1 是不适用是用户 2 不适用不适用

我无法创建一个 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

【问题讨论】：

标签： vba excel concatenation vlookup

【解决方案1】：

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

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

【讨论】：