VBA：把excel文件根据某列拆分成不同的utf-8格式的txt文件

前言：同事有个上传文件的需求，要求格式为utf-8格式的txt文件，vba里有个大神写的拆分宏很好用，我在网上又找了写入utf-8 txt文件的办法，组合了一下，就成了以下代码，试验了一下可以拆分

Sub 拆分()
  Dim path As String
  '获取字典
  Set d = CreateObject("scripting.dictionary")
  
  '获取当前待处理的工作表名称
  sheet_name = ActiveSheet.Name

  '输入获取拆分需要的条件列
  Dim col_name
  col_name = Application.InputBox("请输入拆分依据的列号(如A):")

  '输入拆分的开始行，要求输入的是数字（我这边注释掉了，因为一般都是从第二行开始拆分）
  'Dim start_row As Integer
  'start_row = Application.InputBox(prompt:="请输入拆分的开始行:", Type:=1)
  start_row = 2

  '暂停屏幕更新
  Application.ScreenUpdating = False

  '工作表的总行数
  Dim end_row
  end_row = Worksheets(sheet_name).Range("A1048576").End(xlUp).Row
  
  '把同类的所有行放入字典的item，类似于",2:2,3:3,5:5"这种
  For i = start_row To end_row
    d(Worksheets(sheet_name).Cells(i, col_name).Value) = _
    d(Worksheets(sheet_name).Cells(i, col_name).Value) & "," & i
  Next
  
  '创建存放拆分表格的文件夹
  On Error Resume Next
  VBA.MkDir ThisWorkbook.path & "\拆分数据"

  '遍历字典的Key,key值即为拆分的一个类别，key对应的item为该类别所在的行，复制这些行到新表，新表的名称为这个类别
  Dim columnmax As Integer
  columnmax = Worksheets(sheet_name).UsedRange.Columns.Count
  For Each k In d.keys
    arr = VBA.Split(d(k), ",")
    wb_name = ThisWorkbook.path & "\拆分数据\" & k & ".txt"
    '这边就是txt的创建和写入
    Set adodbStream = CreateObject("ADODB.Stream")
    With adodbStream
      .Type = 2
      .Charset = "UTF-8"
      .Open
      '这里是写入第一列的标题，vbTab是制表符，vbCrLf是换行符
      For i = 1 To columnmax
        .WriteText ThisWorkbook.Sheets(sheet_name).Cells(1, i).Value & vbTab
      Next
      .WriteText vbCrLf
      '这边加了一个如果ar是空则跳到a（也就是next）的步骤，因为原代码中ar第一个有可能是空，导致出来的结果可能会有0 0 0 0 0这样的行
      For Each ar In arr
        If ar = "" Then GoTo a
        For j = 1 To columnmax
          temp = ThisWorkbook.Sheets(sheet_name).Cells(ar, j).Value
          .WriteText temp & vbTab
        Next
        .WriteText vbCrLf
a:
      Next
      .SaveToFile wb_name, 2
    End With
  Next

  '进行屏幕更新
  Application.ScreenUpdating = True

  MsgBox "拆分工作表完成，拆分好的数据在\拆分数据\文件夹下"

End Sub