Question

我有一个大型数据集（约96,000个条目），代表不同教育机构运营的课程。总共有大约5,500个不同的课程提供者。

每个课程都有自己的行，其中包含标识提供者ID的列（即，对于一个提供者ID，有750行代表与每个课程相关的各种信息，而不是每行包含单个提供者提供的所有课程。）。这里提供了一个数据示例：

   +-----------+-------------+-----------------------+---------------------------------------+------------------------------------------------------+--------------------+-----------------------+
| COURSE_ID | PROVIDER_ID |        LAD_ID         |         PROVIDER_COURSE_TITLE         |                    COURSE_SUMMARY                    | PROVIDER_COURSE_ID |      COURSE_URL       |
+-----------+-------------+-----------------------+---------------------------------------+------------------------------------------------------+--------------------+-----------------------+
|  53072591 |      300015 |                       | Functional English 1                  | English Entry 3 and Level 1                          |                    | http://www.asfc.ac.uk |
|  53072593 |      300015 |                       | Functional English 2                  | Literacy level 1 and 2                               |                    | http://www.asfc.ac.uk |
|  53072595 |      300015 |                       | Functional Maths 1                    | "Anyone who wants to improve their maths skills .    |                    | http://www.asfc.ac.uk |
|  53728417 |      300015 |                       | HND in Creative Media Production      | This course is aimed at those with a passion         |                    | http://www.asfc.ac.uk |
|  53887498 |      300017 | 60133600              | Floristry NCFE Creative Craft Level 1 | This is an assessed course                           | AADE1215XA         | http://www.esc.ac.uk/ |
|  53887499 |      300017 | 60132322              | Floristry NCFE Creative Craft Level 2 | This course follows on from the NCFE Level 1         | AADE1218XA         | http://www.esc.ac.uk/ |
|  53887500 |      300017 | Z0002105              | Upholstery                            | This course will give you                            | AADE1X37XA         | http://www.esc.ac.uk/ |
|  53887501 |      300017 | Z0002105              | Upholstery                            | The aim of this course is to give the inexperienced  | AADE1X38XA         | http://www.esc.ac.uk/ |
+-----------+-------------+-----------------------+---------------------------------------+------------------------------------------------------+--------------------+-----------------------+

我想创建一个新的工作表格式，以便每行代表一个唯一的提供程序（例如，第2行的Provider i.d 300015，第3行的300017），然后是该提供程序在同一行上运行的每个单独的课程。如果我只能从原始工作表中选择每个课程的字段PROVIDER_COURSE_TITLE，COURSE_SUMMARY，COURSE_URL来复制到新工作表而不是整行，那将是理想的。

最终我正在寻找一个看起来有点像这样的表

+-------------+----------------------+-----------------------------+-----------------------+----------------------+------------------------+-----------------------+
| PROVIDER_ID |    COURSE_TITLE1     |       COURSE_SUMMARY1       |      COURSE_URL1      |    COURSE_TITLE2     |    COURSE_SUMMARY2     |      COURSE_URL2      |
+-------------+----------------------+-----------------------------+-----------------------+----------------------+------------------------+-----------------------+
|      300015 | Functional English 1 | English Entry 3 and Level 1 | http://www.asfc.ac.uk | Functional English 2 | Literacy level 1 and 2 | http://www.asfc.ac.uk |
+-------------+----------------------+-----------------------------+-----------------------+----------------------+------------------------+-----------------------+

因此，我基本上需要一个宏来搜索PROVIDER_ID列并标识唯一的提供者ID，然后将其复制到新工作表中。然后它标识具有该Provider_ID的所有行，并从每个行复制PROVIDER_COURSE_TITLE，COURSE_SUMMARY和COURSE_URL，并将它们粘贴到该provider_id的单数行的新工作表中。

我花了一整天的时间试图了解这个问题，让其他几个人看看这个，我们无法弄清楚循环，找到下一个空白单元格命令，以及继续前进的规则到下一个需要的PROVIDER_ID。

Answer 1

以下是为您执行此操作的例程。将此例程放在标准代码模块中：

Sub Courses()
    Dim c&, i&, j&, k&, s$, v, w
    v = [A1].CurrentRegion
    For i = 2 To UBound(v)
        If InStr(s, "|" & v(i, 2)) = 0 Then s = s & "|" & v(i, 2)
    Next
    ReDim w(1 To 1 + UBound(Split(s, "|")), 1 To 10000)
    w(1, 1) = "PROVIDER_ID"
    s = ""
    k = 1
    For i = 2 To UBound(v)
        If s <> v(i, 2) Then
            c = 1
            j = 1
            k = k + 1
            s = v(i, 2)
            w(k, 1) = v(i, 2)
        End If
        w(k, j + 1) = Trim$(v(i, 4)): If Len(w(1, j + 1)) = 0 Then w(1, j + 1) = "COURSE_TITLE" & c
        w(k, j + 2) = Trim$(v(i, 5)): If Len(w(1, j + 2)) = 0 Then w(1, j + 2) = "COURSE_SUMMARY" & c
        w(k, j + 3) = Trim$(v(i, 7)): If Len(w(1, j + 3)) = 0 Then w(1, j + 3) = "COURSE_URL" & c
        j = j + 3
        c = c + 1
    Next
    Sheets.Add After:=ActiveSheet
    [A1].Resize(UBound(w, 1), UBound(w, 2)) = w
    Cells.EntireColumn.AutoFit
End Sub

然后在要完成工作的工作表上，按ALT-F8打开宏对话框。

运行课程宏。

那就是它。

Answer 2

未测试：

Sub Test()

    Dim rngSrc As Range, rw As Range
    Dim dictR As Object, dictC As Object, shtDest As Worksheet
    Dim pid, rL As Long, cD As Range

    Set dictR = CreateObject("scripting.dictionary")
    Set dictC = CreateObject("scripting.dictionary")

    Set rngSrc = ActiveSheet.Range("a1").CurrentRegion
    Set shtDest = ActiveWorkbook.Sheets("Reformatted")

    'first empty row...
    rL = shtDest.Cells(Rows.Count, 1).End(xlUp).Row + 1

    For Each rw In rngSrc.Rows
        pid = Trim(rw.Cells(2).Value)

        If Not dictR.exists(pid) Then
            dictR.Add pid, rL  'tracking row
            dictC.Add pid, 2  'tracking column
            shtDest.Cells(rL, 1).Value = pid
            rL = rL + 1
        End If

        Set cD = shtDest.Cells(dictR(pid), dictC(pid))
        cD.Resize(1, 3).Value = Array(Trim(rw.Cells(4).Value), _
                                      Trim(rw.Cells(5).Value), _
                                      Trim(rw.Cells(7).Value))

        dictC(pid) = dictC(pid) + 3 'increment columns

    Next rw

End Sub

将特定单元格从不同的行复制到单独的工作表上的一行中。根据原始

2 个答案: