使用两个列条件将数据转移到新工作表

Question

因此，这个问题已经呈现给我，并且正在成为我网站制作中的巨大障碍。 在界面方面，我并不是什么新人，但是编写函数是我从来没有处理过的事情。 我有一个表，其值用参考数字标记，基本上可以中继由某个提供程序填写的表单。 需要分解字段具有所有不同答案的列（是的，叹息，它在一个列中具有不同的字段答案），因此我可以用列标题标记它们，以便最终将它们导入到SQL数据库中。 当前以以下格式交付源：

我需要做的是能够填写这些值的基于列的版本，如下所示：

创建列的条件基于BC和D中的值。我想我需要创建某种条件语句来检查C和D是否等于某个值（C和D指定是E中的信息类型，因此它们几乎是我的关键元素/条件），然后将信息放在单元E中正确列标题的下面。 我一直在研究诸如VLookup / Match / Index之类的功能，但我对如何应用它们或让我可以使用更好的功能来完成任务的意义不大。 在这一点上，即使是引用相关的SO线程也将非常有用。 我基本上只需要一些指导就可以完成这项工作。 最重要的是，参考编号会上升，但没有任何特定的顺序，因此我想知道是否有可能向函数提供一个参考编号列表，以便在为一个特定参考编号运行完所有条件之后，该参考编号列表才能递增。

编辑：好的，所以这是我的新问题->

您所请求的图像原始数据： http : //imgur.com/htvzqNU VBA脚本之后： http : //imgur.com/cDQQxE6

这是我们编辑的唯一代码：

vHDRs = Array(Array("Reference #", -1, -2), _
                  Array("Provider Name", 300, 100), _
                  Array("Provider Number", 300, 300), _
                  Array("County", 200, 400), _
                  Array("Address", 100, 100), _
                  Array("Zip", 200, 300))

如您所见，地址栏未填充

Answer 1

这是一个相当标准的VBA潜水艇，具有足够的安全性，因此不应破坏任何物质。

Sub My_Organize()
    Dim rw As Long, v As Long, vHDRs As Variant
    Dim i As Long, j As Long, iREFNO As Long, iREFROW As Long, iLR As Long
    Dim ws As Worksheet, app As Application

    Set app = Application
    app.ScreenUpdating = False
    app.EnableEvents = False
    app.DisplayAlerts = False
    app.Calculation = xlCalculationManual

    On Error Resume Next
    Worksheets("Organized").Delete
    On Error GoTo Safe_Exit
    Worksheets.Add(after:=Sheets(Sheets.Count)).Name = "Organized"
    Set ws = Sheets(Sheets.Count)

    vHDRs = Array(Array("Reference #", -1, -2), _
                  Array("Provider Name", 4200, 100), _
                  Array("Phone #", 4300, 100))

    ws.Cells(1, 1).Resize(1, UBound(vHDRs) + 1) = app.Transpose(app.Index(vHDRs, , 1))

    With Sheet1
        iLR = .Cells(Rows.Count, 1).End(xlUp).Row
        With .Cells(1, 1).CurrentRegion
            .Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
                        Key2:=.Columns(3), Order2:=xlAscending, _
                        Key3:=.Columns(4), Order3:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlYes

            For rw = 2 To iLR
                If iREFNO <> .Cells(rw, 1).Value2 Then
                    iREFNO = .Cells(rw, 1).Value2
                    iREFROW = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    ws.Cells(iREFROW, 1) = iREFNO
                End If
                For i = LBound(vHDRs, 1) To UBound(vHDRs, 1)
                    If .Cells(rw, 3).Value2 = vHDRs(i)(1) And _
                       .Cells(rw, 4).Value2 = vHDRs(i)(2) Then
                          ws.Cells(iREFROW, i + 1) = .Cells(rw, 5).Value2
                          Exit For
                    End If
                Next i
            Next rw
        End With
    End With

Safe_Exit:
    Set ws = Nothing
    app.Calculation = xlCalculationAutomatic
    app.DisplayAlerts = True
    app.EnableEvents = True
    app.ScreenUpdating = True
    Set app = Nothing
End Sub

编辑vHDRs信息的嵌套数组，以匹配要从源工作表收集和转置的内容。 只需在其中添加一个新的嵌套数组，然后更改标签和数字即可与C和D列匹配。它们在外部数组中不必按任何特殊顺序排列，但每个内部数组应为标签，C列，D列 。

将数据粘贴到新工作簿的Sheet1中 ，然后对它运行该例程。 它将在队列末尾创建一个新的工作表，并根据您在列标题标签数组中设置的参数以及其他两个与源工作表中的C和D列匹配的数字（即Sheet1 ）来转置数据。 。

如果针对23M行（在多个工作表中）重复运行该命令，则可以将这些值批量输入到数组中，以便所有处理都将在内存中完成。