我当前ISS项目中一些ADaM变量的属性，需要从SDTM Spec中获取。这个过程需要查询比对3个EXCEL文件内容，人工查询耗时耗力，于是考虑使用VBA编程进行批量处理。

由于各家公司SPEC的结构设置不同，这篇文章的实现思路仅供参考。以获取CT信息为例，最后获取信息的结果如下：

文章第3部分的具体编程中，分别介绍了这个过程中的功能模块，方便读者迁移使用；第4部分是完整程序的代码汇总。

对于规则明确、机械重复的Excel工作，推荐读者尝试使用VBA编程进行处理，这样可以大大节约人力，提高效率。

若读者想从零学习VBA编程，推荐杨洋老师的《全民一起VBA》系列课程。杨老师的课程，是我所接触到的最通俗易懂、最易上手的VBA课程。

1. 问题的由来

ISS (Integrated Summary of Safety)，是指药物开发过程中，对不同临床试验的安全性数据进行汇总分析的报告，用于评估药物的整体安全性。对于同一个试验药物可能开展不同的临床试验，这些试验的试验设计、数据收集与分析，是很相似的。

当前ISS项目的数据来源于5个individual study，这5个Study共用同一个SPEC，ISS单独使用一套SPEC。在公司当前的SPEC结构下，对直接来源于SDTM的ADaM变量，其属性是没有在ADaM SPEC中记录的，公司宏程序可以直接为这些变量从SDTM Spec中抓取属性。

但由于ISS只在ADaM层面进行数据整合，不会有SDTM Spec，在Individual Study Spec中被省略的属性信息需要自己手动去填写。这个过程涉及ISS ADaM Spec、Individual Study ADaM Spec以及Individual Study SDTM Spec内容的比对，人工处理实在太过繁琐。

2. VBA编程思路

首先，主体程序中，会新建一个Excel文档，用于保存最后的查询结果。文档会提前设置好输出的列名与Sheet名称。

然后，对3个EXCEL Spec中的Sheet与变量进行嵌套循环。当循环遍历到3个Spec中对应的数据集变量时，将需要的信息输出到新建的EXCEL文档中。

整体来看，这个过程是对3个EXCEL中的每一个数据集Sheet、Sheet中的每个变量进行循环判断，输出满足特定条件的信息。

3. 具体VBA编程

3.1 新建EXCEL文档，处理后进行保存

对于获取到的查询结果，通常在VBA程序中，新建一个Workbook保存结果。考虑到阅读的方便，会先在这个文件中填写一些列名信息。想要的信息处理完毕后，文档会保存到特定路径中。。

Sub Create_Workbook()

  'Create EXCEL file to save results
  Dim rst As Workbook
  Set rst = Workbooks.Add

  rst.Sheets(1).name = "Results"
  
  rst.Sheets(1).Cells(1, 1) = "No."
  rst.Sheets(1).Cells(1, 2) = "ADaM"
  rst.Sheets(1).Cells(1, 3) = "SDTM"
  rst.Sheets(1).Cells(1, 4) = "Variable"
  rst.Sheets(1).Cells(1, 5) = "Codelist"

  'Save file after all things done
  rst.SaveAs "\aaa\bbb\test_workbook.xlsx"
  rst.close
End Sub

程序运行结果输出如下：

VBA程序中，点号.使用得越多，程序运行效率会越低。通常，使用With--End With语句来减少点号.使用的频次。

代码修改如下，运行结果相同：

Sub Create_Workbook()

  'Create EXCEL file to save results
  Dim rst As Workbook
  Set rst = Workbooks.Add
  
  With rst.Sheets(1)
    .name = "Results"
    .Cells(1, 1) = "No."
    .Cells(1, 2) = "ADaM"
    .Cells(1, 3) = "SDTM"
    .Cells(1, 4) = "Variable"
    .Cells(1, 5) = "Codelist"
  End With

  'Save file after all things done
  rst.SaveAs "\aaa\bbb\test_workbook.xlsx"
  rst.close
End Sub

3.2 获取特定单元格列信息的函数

EXCEL单元格的信息由行和列构成，变量的属性信息一般都在固定行（例如，第1行）。不同属性信息的列可能由于数据集的不同，而有细微差别。

嵌套循环中需要多次获取特定列的位置，所以建立一个函数重复调用，获取列的信息，可以提升编程效率。当然，也可以人工找到列信息后，直接手动写在程序中，这个也不是很复杂。

函数程序举例如下：

Option Explicit

'Get Column number
Function Get_Col_Num(Worksheet, name)

  Dim k&, col_num&, col_nam$
  k = 1
  col_num = 0 
  col_nam = name

  Dim wb As Worksheet
  Set wb = Worksheet

  Do While wb.Cells(1, k) <> ""
    If UCase(Trim(wb.Cells(1, k ))) = UCase(Trim(col_nam)) Then
      col_num = k
    End If

    k = k + 1
  Loop

  Get_Col_Num = col_num

End Function

循环语句中，需要注意一个易错点。计数变量一定要进行累加 (k = k + 1)，否则循环条件会一直成立。语句运行会陷入死循环，最后只能强制关掉EXCEL程序。

写一个简单的程序来展示一下这个函数：

Sub test_col()
  Dim nam$, coln&
  nam = "3"
  coln = Get_Col_Num(Application.ActiveSheet, nam)

  MsgBox "Coln = " & coln
End Sub

当单元格值为3时，列数显示如下：

3.3 统计程序执行时间

在进行VBA编程时，可能需要比较不同程序算法的运行效率，最直接的指标就是程序运行的时间。这个可以通过使用系统时间函数time()与时间运算函数DateDiff实现。

思路是，在程序过程的开头，记录下系统时间。当过程运行结束后，将结束时的系统时间与开始时的系统时间进行做差，并用对话框将差值显示出来。

示例代码如下：

Option Explicit

Sub test()
  Dim startTime
  startTime = Time()

  ‘Running Code
  
  MsgBox "Program running time : " & Datediff("s", startTime, Time()) & " s."
End Sub

在下一小节会使用这个方法，对两个程序算法的运行时间进行比较。

3.4 三个EXCEL文件的嵌套循环

嵌套循环的具体思路是，打开ISS ADaM Spec，依次对每一个数据集Sheet中的每一个变量进行循环判断。如果当前变量的Codelist为空，打开Individual Study ADaM Spec，找到对应数据集变量的记录，判断其来源是否为SDTM。如果来源为SDTM，就打开Individual Study SDTM Spec，抓取对应变量的CT信息。信息抓取后，直接输出到新建的EXCEL中。

处理EXCEL工作簿的第一步，是打开工作簿。在这之前，需要声明工作簿对象指向打开的工作簿，一并声明工作表对象，方便后续循环应用。

'Open EXCEL Files
Dim dadam As Workbook, padam As Workbook, psdtm As Workbook, dadt As Worksheet, padt As Worksheet, sdtm As Worksheet

Set dadam = Wokrbooks.Open("\XXX\XXX\ISS_ADaM_Spec.xlsx")
Set padam = Wokrbooks.Open("\XXX\XXX\Product_ADaM_Spec.xlsx")
Set psdtm= Wokrbooks.Open("\XXX\XXX\Product_SDTM_Spec.xlsx")

信息获取的整个过程，由3个大的循环构成，即在3个Spec中各自遍历变量；在每个大的循环中，又有2个小的循环，即Spec中每个数据集sheet的遍历与sheet中每个变量的遍历。 最终匹配到符合条件的ISS_ADaM_Spec、IndStudy_ADaM_Spec以及IndStudy_SDTM_Spec对应的各个变量。

如果熟悉VBA的循环结构，上述的嵌套循环思路实现起来并不复杂。由于一些列在不同数据集sheet中位置有细微差别，需要调用前面编写的获取列数的函数，遍历不同的Sheet时，方便定位到具体信息位置。

循环示例程序参见第4节程序汇总。

关于这里的嵌套循环，有一点建议。嵌套循环如果不做处理的话，一般会遍历所有可能的结果。但是在实际循环中，当匹配到3个Spec中对应的3个变量后，剩余的循环就没有任何实际意义了。

于是，在获取想要的信息后，可以直接跳出当前变量的循环。VBA中，跳出多个循环，使用Goto语句；如果只需跳出单个循环，使用Exit语句。

参考上一节统计程序执行时间的程序，测试下来，使用Goto语句跳出多余循环，程序运行时间为134秒。

不使用Goto语句跳出多余循环，程序运行时间为143秒

两者运行时间相差9秒，与100多秒的总运行时间相比，这9秒的提升似乎意义不大。总运行时间之所以比较长，是因为主题程序需要打开3个包含多个Sheet的EXCEL文件，这一块花费的时间比较长。除去打开文件消耗的时间，9秒的效率提升还是比较可观的。

4. 程序汇总

以上完整程序汇总如下：

Option Explicit

'Get Column number
Function Get_Col_Num(Worksheet, name)

  Dim k&, col_num&, col_nam$
  k = 1
  col_num = 0 
  col_nam = name

  Dim wb As Worksheet
  Set wb = Worksheet

  Do While wb.Cells(1, k) <> ""
    If UCase(Trim(wb.Cells(1, k ))) = UCase(Trim(col_nam)) Then
      col_num = k
    End If

    k = k + 1
  Loop

  Get_Col_Num = col_num

End Function

'dadam ADaM var with missing Codelist
'Check padam ADaM var with Origin = SDTM
'Check psdtm SDTM var's Codelist

Sub Check_SDTM_Var_CT()
  'Check program running time
  Dim startTime
  startTime = Time()
  
  'Create EXCEL file to save results
  Dim rst As Workbook
  Set rst = Workbooks.Add

  With rst.Sheets(1)
    .name = "Results"
    .Cells(1, 1) = "No."
    .Cells(1, 2) = "ADaM"
    .Cells(1, 3) = "SDTM"
    .Cells(1, 4) = "Variable"
    .Cells(1, 5) = "Codelist"
  End With

  Dim rstnum&
  rstnum = 1

  'Open EXCEL Files
  Dim dadam As Workbook, padam As Workbook, psdtm As Workbook, dadt  As Worksheet, padt As Worksheet, sdtm As Worksheet

  Set dadam = Wokrbooks.Open("\XXX\XXX\ISS_ADaM_Spec.xlsx")
  Set padam = Wokrbooks.Open("\XXX\XXX\Product_ADaM_Spec.xlsx")
  Set psdtm= Wokrbooks.Open("\XXX\XXX\Product_SDTM_Spec.xlsx")
  
  'For each ADaMs in dadam
  Dim k&, kk&, kkk&, dadam_col_num&, dadam_ct_num&, padam_origin_num, padam_source_num&, psdtm_ct_num&

  'Col name for check number
  Dim nam1$, nam2$, nam3$, nam4$

  nam1 = "ISS"
  nam2 = "CodeListRef"
  nam3 = "Origin"
  nam4 = "SourceDerivation"
  
  'For each ISS ADaM sheet
  For Each dadt In dadam.Worksheets
    If Left(dadt.name, 2) = "AD" Then
      dadam_col_num = Get_Col_Num(dadt, nam1)
      dadam_ct_num = Get_Col_Num(dadt, nam2)

      k = 2

      'For each variables in dadam sheet  
        Do while dadt.Cells(k, 1) <> ""

          'Missing CT name
          If dadt.Cells(k, dadam_col_num) <> "NA" and dadt.Cells(k, dadam_col_num) <> "" And dadt.Cells(k, dadam_ct_num) = "" Then

            'For each ADaMs in padam
            For each padt In padam.Worksheets
            If padt.name = dadt.name Then

              padam_origin_num = Get_Col_Num(padt, nam3)
              padam_source_num = Get_Col_Num(padt, nam4)

              kk = 2
              Do while padt.cells(kk, 1) <> ""

                If padt.Cells(kk, 1) = dadt.Cells(k, 1) Then

                  'Variables from SDTM
                  If padt.Cells(kk, padam_origin_num) = "SDTM" Then

                  'For Each sdtm In psdtm 
                  For Each sdtm In psdtm.Worksheets
                    If sdtm.name = padt.Cells(kk, padam_source_num) or sdtm.name = right(padt.cells(kk, padam_source_num), 2) Then

                       psdtm_ct_num = Get_Col_Num(sdtm, nam2)
                       
                       kkk = 2
                       Do While sdtm.Cells(kkk, 1) <> ""
                           If sdtm.Cells(kkk, 1) = padt.Cells(kk, 1) Then
                             If sdtm.Cells(kkk, psdtm_ct_num) <> "" Then

                               'Output results
                               with rst.Sheets(1)
                                 .Cells(rstnum + 1, 1) = rstnum
                                 .Cells(rstnum + 1, 2) = padt.name
                                 .Cells(rstnum + 1, 3) = sdtm.name
                                 .Cells(rstnum + 1, 4) = sdtm.Cells(kkk, 1)
                                 .Cells(rstnum + 1, 5) = sdtm.Cells(kkk, psdtm_ct_num)
                               End With

                               rstnum = rstnum + 1

                               GoTo endloop:
                           End If
                         End If

                         kkk = kkk + 1
                       Loop
                    End If
                  Next sdtm
                 End If
                End If

                kk = kk + 1
              Loop
            End If 
            next padt
          End If
endloop:
          k = k + 1
        Loop
    End If
  Next dadt

  'Save EXCEL file
  rst.SaveAs "/xx/xxx/results.xlsx"

  'Check program running time
  MsgBox "Program running time : " & DateDiff("s",  startTime, Time()) & " s."
  
End Sub

总结

由于各家Spec布局、功能需求不同，以上代码读者很难直接借鉴，但是模块思路是可以参考的。

希望这篇文章，能够对读者处理机械的EXCEL任务有所启发。熟悉VBA的基础语句，使用VBA编程EXCEL相关的信息整理，将会大大节约时间、提升效率。

感谢阅读，欢迎关注：SAS茶谈！
若有疑问，欢迎评论交流！
欢迎点赞、转发！