ExcelVBA函数:按字典将编号翻译为对应的描述

原创
2018/08/27 19:35
阅读数 395

最近遇到了一个问题,一个Excel文档有两个Sheet页

第一个Sheet页(Sheet.Name="字典")存放了业务规则编号和描述的对应关系,格式如下:

- - 规则描述 规则描述(详细) - 规则编号
    规则x的描述     x
    规则y的描述 规则y的详细描述   y
    规则z的描述     z

第二个Sheet页(Sheet.Name="规则对照表")存放了业务和业务规则的对应关系,一个业务可能对应多条规则,格式如下:

业务种类 检查项1 检查项2 检查项3 检查项4
业务1

x

y

a b  
业务2 x a b c
业务3 y a    

因为第二个Sheet页的内容很不直观,每次修改与核对起来都非常费力,因此我写了一个宏,在第三个Sheet页(Sheet.Name="规则对照表(翻译表)")中,填入以下内容:

业务种类 检查项1 检查项2 检查项3 检查项4
业务1

规则x的描述

规则y的描述(规则y的详细描述)

规则a的描述 规则b的描述  
业务2 规则x的描述 规则a的描述 规则b的描述 规则c的描述
业务3 规则y的描述(规则y的详细描述) 规则a的描述    

操作步骤:

0、程序版本:Microsoft Office Professional Plus 2010

1、调出工具栏中的【开发工具】选项卡。如果工具栏中没有【开发工具】选项卡,则先进入【文件】选项卡,点击左侧菜单的【选项】(在【帮助】下方,【退出】上方)。进入【Excel选项】界面后,找到【自定义功能区】,此时会有左右两栏,左侧为【从下列位置选择命令】,右侧为【自定义功能区】,在右侧【自定义功能区】中选择【主选项卡】,将【开发工具】打钩,点击【确定】按钮保存操作。

2、新建按钮,绑定函数。在【开发工具】选项卡下,点击【插入】按钮,在弹出的菜单中选择【表单控件】中的【按钮】,并在代码编辑器中为之绑定一个函数。函数取名为Sync。用鼠标右键单击按钮,在弹出菜单中点击【编辑文字】,填写“同步数据”。

3、输入代码。在【开发工具】选项卡下,点击【Visual Basic】按钮,进入代码编辑器,编辑函数Sync。

Sub Sync()
  
  Dim Start As Integer
  Dim Finish As Integer
  Dim Left As Integer
  Dim Right As Integer
  
  Start = 3
  Finish = 20 '翻译范围,从第3行到第20行
  Left = 3
  Right = 30  '翻译范围,从第3列到第30列
  
  Dim SheetRule       '规则:存放各个不同业务对应的规则(编号)
  Dim SheetRuleDesc   '字典:存放各个不同业务对应的规则(描述及解释)
  
  Set SheetRule = Workbook(1).Sheets("规则对照表")
  Set SheetRuleDesc = Workbook(1).Sheets("规则对照表(翻译版)")
  
  For I = Start To Finish
    For J = Left To Right
      SheetRuleDesc.Cells(I, J).Value = ""
      Dim Rules, RuleList, RuleDesc
      RuleDesc = ""
      Rules = SheetRule.Cells(I, J)
      Rules = Trim(Rules)
      If Rules <> "" Then
        RuleList = Split(Rules, Chr(10)) '按行分割
        Cnt = 1
        For K = 0 To UBound(RuleList)
          RuleList(K) = Trim(RuleList(K))
          If RuleList(K) <> "" Then
            If RuleDesc = "" Then
              RuleDesc = Cnt & "." & GetRuleDesc(RuleList(K))
            Else
              RuleDesc = RuleDesc & Cnt & "." & GetRuleDesc(RuleList(K))
            End If
          End If
          Cnt = Cnt + 1
        Next
      End If
      SheetRuleDesc.Cells(I, J).Value = RuleDesc
    Next
  Next
  
End Sub

Function GetRuleDesc(Code)

  Dim SheetDict  '字典:存放编号对应的规则描述及解释
  Set SheetDict = Workbook(1).Sheets("字典")
  
  Dim Start As Integer
  Dim Finish As Integer
  Dim ColCode As Integer
  Dim ColDesc As Integer
  Dim ColDesc2 As Integer

  Start = 2
  Finish = 300
  ColCode = 6
  ColDesc = 3
  ColDesc2 = 4
  
  GetRuleDesc = ""
  For I = Start To Finish
    RuleCode = SheetDict.Cells(I, ColCode)
    RuleCode = Trim(RuleCode)
    If RuleCode <> "" And RuleCode = Code Then
      RuleDesc = SheetDict.Cells(I, ColDesc)
      RuleDesc = Trim(RuleDesc)
      RuleDesc2 = SheetDict.Cells(I, ColDesc2)
      RuleDesc2 = Trim(RuleDesc2)
      If RuleDesc2 = "" Then
        GetRuleDesc = RuleDesc
      Else
        GetRuleDesc = RuleDesc + "【" + RuleDesc2 + "】"
      EndIf
      Exit For
    End If
  Next
  

End Function

END

展开阅读全文
加载中

作者的其它热门文章

打赏
0
0 收藏
分享
打赏
0 评论
0 收藏
0
分享
返回顶部
顶部