VBA编程:项目Spec相关内容的批量处理

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

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

  1. 在每张Sheet中批量添加Analysis列名
  2. 不同版本Spec的变量更新标记
  3. 不同版本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),具体如下:

  • Application,代表EXCEL系统本身
  • WorkBook,代表一个Excel文件
  • Worksheet,代表一张工作表
  • Range, 代表单元格组成的区域

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

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

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

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

具体到VBA编程中,有两个要点:

  • 第一,如何判断到达首行末尾;
  • 第二,如果首行已经存在对应列名,就不需要再次添加。

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

代码中使用While结构进行循环,跳出循环时,计数变量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实现以上内容的思路与标记新变量的思路类似,循环遍历两个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茶谈!
若有疑问,欢迎评论交流!
欢迎点赞、转发!

最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
【社区内容提示】社区部分内容疑似由AI辅助生成,浏览时请结合常识与多方信息审慎甄别。
平台声明:文章内容(如有图片或视频亦包括在内)由作者上传并发布,文章内容仅代表作者本人观点,简书系信息发布平台,仅提供信息存储服务。

相关阅读更多精彩内容

友情链接更多精彩内容