vba编程-VBA编程：项目Spec相关内容的批量处理

在临床试验项目中，SDTM、ADaM的SPEC一般保存在EXCEL文档中。SPEC的创建和维护，有许多规则明确、机械重复的步骤。对于这些内容，如果能实现自动化批量处理，将会大大缩短工作时间、提高工作效率。

这篇文章，会展示3个使用VBA编程对EXCEL Spec进行批量处理的示例：

在每张Sheet中批量添加Analysis列名

不同版本Spec的变量更新标记

不同版本Spec的相同变量的内容提取

文章内容以介绍VBA程序思路、分享代码为主，不会聚焦具体语法细节。希望借助具体案例，为读者VBA的学习提供一些启发与帮助。

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

0. VBA的简单介绍

什么是VBA？百度百科的解释如下：

VBA (Visual Basic for Applications) 是Visual Basic的一种宏语言，是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。

VBA是微软公司针对Office系列办公软件，推出的VB语法的编程语言。当我们使用Office软件进行机械重复的操作时，可以使用VBA写一些小程序来自动处理这些重复的操作，从而提高处理效率。

虽然，之前也介绍过SAS对EXCEL的批量处理，但就代码复杂程度来讲，同样的功能，VBA实现起来就要简洁的多得多。同时，针对大批量EXCEL Sheet的处理，VBA处理的速度也比SAS快得多。

VBA是一种面向对象的程序语言，主要语法会说明有几类事物 (类，Class)，事物各自有什么属性 (Attribute)，事物又能做什么事情 (方法，Method)。按照各个概念的组合，就会产生具体的事物——对象 (Object)。

VBA常用有4个类 (Class)，具体如下:

下面具体介绍几个VBA功能示例，

1. 在每张Sheet中批量添加Analysis列名

有的公司一个Product的项目可能共用一个Excel Spec，每一个Analysis都会在这个Spec中的特定列进行内容的更新与修改，并且每一列都有一个特定的列名。

具体来讲，每当新开展一个Analysis，就需要在对应数据集的Sheet的末尾添加一列，即第一行末尾单元格中写入一个列名。

具体到VBA编程中，有两个要点：

是否添加列名的关键在于，当前首行是否已经存在对应列名。这里可以指定一个指示变量变量exist = 0，对第一行单元格进行循环判断，如果存在等于列名的值，变量exist赋值为1。如果循环结束，不存在列名值，则在末尾单元格添加列名。

代码中使用While结构进行循环vba编程，跳出循环时，计数变量K (Cells(1, k)) 恰好指向末尾第一个空白单元格。当指定列名不存在时，可以直接赋值。

在填入列名后，代码中也会设置字体大小、加粗，单元格的填充色、上下左右对齐，以及列宽。

Option Explicit

Sub Add_New_col()
  Dim k, exist
  Dim spec As Workbook, adam as Worksheet

  Set spec = Workbooks.Open(\"/xxx/xxx/Spec.xlsx\")

  For Each adam In spec.Worksheets
    k = 1
    exist = 0

    \'Check new col name if exist
    Do While adam.Cells(1, k) <> \"\"
      If UCase(Trim(adam.Cells(1, k))) = \"ANALYSIS NAME\" Then
        exist = exist + 1
      End If
      k = k + 1
    Loop

    \'Add new column name
    if exist = 0 Then
       adam.Cells(1, k) = \"Analysis Name\"

      With adam.Cells(1, k).Font
          .Size = 9
          .Bold = True
      End With

      adam.Cells(1, k).Interior.Color = 49407

      \'Alignment
      With adam.Cells(1, k)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
      End With

      adam.Columns(k).ColumnWidth = 25
    End if
  Next adam
End Sub

2. 不同版本Spec的变量更新标记

有时，某些Analysis的Spec与其他Spec内容相关，例如，ISS的相关分析是多个单独研究分析综合在一起，需要定期查看、比较单个研究Spec的更新变化。这里的更新可能涉及变量的新增、变量的属性变化等。

下面以新增变量为例，演示如何使用VBA编程高亮新增变量行。

程序的思路是，假设Spec_a的变量都是新增的、之前不存在的（exist = 0），然后遍历Spec_a中所有Sheet的所有第一列的变量名称。当选定Spec_a的一个变量时，会接着遍历Spec_b中相同Sheet名称中的所有变量，当出现相同变量名称时，变量exist赋值为1，即该变量在Spec_b中存在。

Spec_a中的一个变量循环结束后，如果exist = 0，那么就表明这个变量不在Spec_b中，即该变量为Spec_a中的新增变量，对其所在行标记为高亮。

演示代码如下：

Option Explicit

Sub Check_New_Var_In_Spec()
  Dim k,kk,exist 
  Dim spec_a As Workbook, spec_b As Workbook, adam_a As Worksheet, adam_b As Worksheet

  set spec_a = Workbooks.Open(\"/xxx/xxxx/spec_a.xlsx\")
  set spec_b = Workbooks.Open(\"/xxx/xxxx/spec_b.xlsx\")

  For Each adam_a In spec_a.Worksheets
    For Each adam_b In spec_b.Worksheets
      If Left(adam_a.name, 2) = \"AD\" and adam_a.name = adam_b.name Then
        k = 2
        \'For each variables in adam_a
        Do While adam_a.Cells(k, 1)  \"\"
          kk = 2
          exist = 0
          \'For each variables in adam_b
          Do While adam_b.Cells(kk, 1) <> \"\"
            If adam_a.Cells(k, 1) = adam_b.Cells(KK, 1) Then
              exist = exist + 1
            End If

            kk = kk + 1
          Loop

          \'The variable exist in spec_a but not in adam_b
           If exist = 0 Then
            adam_a.Rows(k).Interior.Color = 49407
           End If
          
           k = k + 1
        Loop
      End if
    Next adam_b
  Next adam_a
End Sub

3. 不同版本Spec的相同变量的内容提取

有时，某一Spec中变量衍生规则需要直接从另一个Spec中提取，但由于两个Spec所含的变量并非完全相同。这样，变量的位置、顺序就不同，导致无法批量复制粘贴。如果人工对单个变量进行复制粘贴，整个过程就太过繁琐，这时候vba编程，考虑使用VBA编程实现。

VBA实现以上内容的思路与标记新变量的思路类似，循环遍历两个Sheet中的变量。循环到相同的两变量时，把其中的一个变量的Derivation Rule赋值到另一个变量中。

不过，与标记新变量不同的是，新变量标记只需要获取行的信息，而具体内容的获取需要知晓对应单元格的行列信息。行的信息与变量名称的行信息相同，列的信息为对应的分析列名。为了使VBA程序简洁，我通过编写函数，单独获取列信息。

\'Get Analysis 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

函数可以将判断结果进行传输，直接在后续程序中引用，主体程序如下：

Sub Get_Derivation()
  
  Dim k, kk, nam1, nam2
  nam1 = \"Analysis A\"
  nam2 = \"Analysis B\"
  
  Dim spec_a As Workbook, spec_b As Workbook, adam_a As Worksheet, adam_b As Worksheet
  set spec_a = Workbooks.Open(\"/xxx/xxxx/spec_a.xlsx\")
  set spec_b = Workbooks.Open(\"/xxx/xxxx/spec_b.xlsx\")

  For Each adam_a In spec_a.Worksheets
    For Each adam_b In spec_b.Worksheets
      If Left(adam_a.name, 2) = \"AD\" and adam_a.name = adam_b.name Then

        speca_col_num = Get_Col_Num(adam_a, nam1)
        specb_col_num = Get_Col_Num(adam_b, nam2)
        k = 2

        \'For each variables in adam_a
        Do While adam_a.Cells(k, 1)  \"\"
          kk = 2

          \'For each variables in adam_b
          Do While adam_b.Cells(kk, 1) <> \"\"
            If adam_a.Cells(k, 1) = adam_b.Cells(KK, 1) Then
              If Left(adam_b.name, 2) = \"AD\" And specb_col_num > 0 And speca_col_num > 0 Then
               adam_b.Cells(kk, specb_col_num) = adam_a.Cells(k, speca_col_num)
               adam_b.Cells(kk, specb_col_num).Interior.Color = vbYellow 
              End If
            End If

            kk = kk + 1
          Loop
          
           k = k + 1
        Loop
      End if
    Next adam_b
  Next adam_a

End Sub

总结

文章介绍了3个使用VBA编程批量处理Spec内容的示例，对于规则明确、机械重复的步骤，使用VBA编程将会大大提高工作效率，缩短工作时间。希望这篇文章，对读者日常EXCEL Spec的处理有所启发和帮助。

感谢阅读， 欢迎关注：SAS茶谈！

大师兄永久会员

收藏 海报 链接