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

最近遇到了一个问题，一个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

转载于:https://my.oschina.net/Tsybius2014/blog/1934830