当前位置: 动力学知识库 > 问答 > 编程问答 >

excel - Transposing data to a new worksheet with two column criteria

问题描述:

So this problem has been presented to me and it's becoming a huge roadblock in the production of my website. I'm not new to excel when it comes to the interface but writing functions is something that I have never had to deal with. I have a table with values labeled by reference number that basically relay a form that was filled out by a certain provider. The column with all the different answers to the fields (Yes, it has different field answers in one column, sigh) needs to be broken up so I can label them with column headers in order to eventually import them into an SQL database. The source is current delivered in this format:

What I need to do is be able to fill out a column-based version of these values that looks like:

The criteria for creating columns is based on the values in A (ref #) B C and D. I'm guessing I need to create some sort of conditional statement that checks if C and D are equal to a certain value (C and D designate the type of information that is in E so they are pretty much my key element/conditionals) and then places the information in cell E underneath the correct column header. I have been researching functions such as VLookup/Match/Index and I can't make much sense of how to apply them or if there is possibly a better function I can use to accomplish my task. Even a reference to a relevant SO thread would be great at this point. I basically just need some guidance as to what it would take to make this work. On top of that, the reference numbers ascend but are not in any particular order therefore I am wondering if it possible to feed a function a list of reference numbers to increment to once all the conditionals have all been run through for a particular reference number.

EDIT: Ok so here is my new issue -->

The images as you requested

Original Data: http://imgur.com/htvzqNU

After VBA Script: http://imgur.com/cDQQxE6

This is the only code we edited:

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))

As you can see, the column for addresses does not populate

网友答案:

Here is a fairly standard VBA sub with enough safeties that it shouldn't destroy anything of substance.

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

Edit the nested array of vHDRs information to match what you want to collect and transpose from the source worksheet. Just add a new nested array into that and change the label and the numbers to match from columns C & D. They do not have to be in any special order in the outer array but each inner array should be label, column C, column D.

With your data pasted into a new workbook's Sheet1, run that routine against it. It will create a new worksheet at the end of the queue and transpose the data according to the parameters you set up in the array of column header labels, and two other numbers to match from columns C and D on the source worksheet (i.e. Sheet1).

If you run that repeatedly against 23M rows (in multiple worksheets) then the values could be bulk fed into an array so that all processing would be done in memory.

分享给朋友:
您可能感兴趣的文章:
随机阅读: