通过vba将sheet1(基础数据表)的内容通过相关计算自动填充内容到sheet2(数据整理表)-526互联

一、应用场景

基础数据表有产品的初始时间、产品名称、批号、备注。①根据批号自动计算批次，注：每个批次用英文分号分隔开；②根据表头的标志"时间（天）"或者"时间（月）"来计算初始时间+表头数字(月或天)，即计算时间；③根据内容判断是"√"，计算内容就加上该内容。以标志"时间（天）"或者"时间（月）"判断行开始，以标志"标准"判断列结束标志，以标志"备注："判断行结束。

基础数据内容如下：

数据整理测试初始如下：

二、VBA知识点

在vba里字符使用要用双引号，单引号表示注释(好几次使用单引号结果报错)；如果使用变量出现‘1004’应用程序定义或对象定义错误,比如basic_data写成basic，就会报错；字符合并是&；注意填充某个表格下的内容的时候确定表头存在，比如"数据整理测试"表里没有备注作为表头的话，从"基础数据里"把备注填充过来会出现如下错误。

1、函数过程以及定义的子函数

//该过程会自动执行
Sub Mycode()  //定义子程序过程
   ...
   Call MySubCode(a, b)    //调用另一个子程序过程
End Sub  //过程结束

Sub MySubCode(a, b)   //定义另一个子程序过程
   ...
End sub

2、定义变量、获取工作表、查找指定内容的单元格及获取单元格的行列号

Dim row_cur As Integer, col_cur As Integer  //Dim是定义变量，后加变量名，再加As dataType 数据类型，如Worksheet(工作表)、String(字符串)、Integer(整数)
Set basic_data = Worksheets("基础数据")  //获取基础数据工作表
Set findStart = basic_data.UsedRange.Find("时间（月）")  //查找内容为"时间（月）"的单元格，UsedRange返回range对象，代表指定工作表已使用的区域
row_cur = findStart.Row  //获取单元格的行
col_cur = findStart.Column  //获取单元格的列

3、判断单元格是否存在、获取单元格的内容、获取工作表的最后一行、循环体

//If...then...格式
If Not findStart Is Nothing Then   //如果findStart不是空就执行，如果执行的内容和If在同一行，就不用End If
   ....
ElseIf  ... Then
   ...
Else
   ...
End If
//获取单元格内容
MsgBox basic_data.Cells(row_cur, col_cur)  //Cells读取单元格内容，MsgBox是输出内容
//获取工作表的最后一行
rowmax =  basic_data.Cells(65536, 1).End(xlUp).Row  //向上查找
//For循环体
For n = 1 to 10  //n从1到10
   ...
Next
//Do While...Loop循环体
Do While row_cur < row_end
   ...
Loop

4、日期加减、分割字符串、判断是否是合并单元格(如果是就把该行内容和下一行内容加到一起，因为复制的时候内容太长可能会形成两行单元格)

//时间加减
VBA.DateAdd("m", t, Cells(a,b))  //Cells(a,b)单元格时间加上t月
VBA.DateAdd("d", t, Cells(a,b))  //Cells(a,b)单元格时间加上t天
//分割字符串
UBound(Split(batch, ";"))  //split通过英文分号将batch字符串分割成数组，再通过UBound计算数组上限，因为数组是从0开始，所以还得加上1才得长度
//判断是否是合并单元格
If basic_data.Cells(row_cur, col_cur).MergeCells = True Then 
   ...
Else
   ...
End If

三、需求实现

Sub Mycode()
  Dim basic_data As Worksheet
  Set basic_data = Worksheets("基础数据")
  Set findStart = basic_data.UsedRange.Find("时间（月）")
  If Not findStart Is Nothing Then
    Call MySubCode(findStart.Row, findStart.Column, "M")  '时间是月
  ElseIf Not basic_data.UsedRange.Find("时间（天）") Is Nothing Then
    Call MySubCode(basic_data.UsedRange.Find("时间（天）").Row, basic_data.UsedRange.Find("时间（天）").Column, "D") '时间是天
  Else
    MsgBox "没有找到行开始数据，标志是时间（月）或时间（天）"
  End If
  MsgBox "完成"
End Sub

Sub MySubCode(row_start, col_start, point_type)
  Dim row_cur As Integer   '定义当前行位置
  Dim row_end As Integer   '定义结束行位置
  Dim col_cur As Integer   '定义当前列位置
  Dim col_end As Integer   '定义结束列位置
  Dim test_content As String '定义考察内容
  Dim batch As String        '定义批号
  Dim up_data As Worksheet    '数据整理工作表
  Dim basic_data As Worksheet '基础数据工作表
  Set basic_data = Worksheets("基础数据")
  Set up_data = Worksheets("数据整理测试")
  Set findEnd = basic_data.UsedRange.Find("备注：")
  row_end = findEnd.Row - 1
  
  If Not findEnd Is Nothing Then
    col_cur = col_start + 2       '跳过0那列
    I = up_data.Cells(65536, 1).End(xlUp).Row + 2 '在sheet2数据整理表中第二个空行开始，就是向上查找第一个有数据单元格的下2个单元格
    Do While basic_data.Cells(row_start, col_cur) <> "标准" And basic_data.Cells(row_start, col_cur) <> ""
       row_cur = row_start + 2      '跳过内容那一行
       up_data.Cells(I, up_data.UsedRange.Find("初始时间").Column).Value = basic_data.Cells(2, basic_data.UsedRange.Find("初始时间").Column)
       up_data.Cells(I, up_data.UsedRange.Find("产品名称").Column).Value = basic_data.Cells(2, basic_data.UsedRange.Find("产品名称").Column)
       up_data.Cells(I, up_data.UsedRange.Find("批号").Column).Value = basic_data.Cells(2, basic_data.UsedRange.Find("批号").Column)
       up_data.Cells(I, up_data.UsedRange.Find("备注").Column).Value = basic_data.Cells(2, basic_data.UsedRange.Find("备注").Column)
       If point_type = "M" Then
         up_data.Cells(I, up_data.UsedRange.Find("计算时间").Column).Value = VBA.DateAdd("m", basic_data.Cells(row_start, col_cur), basic_data.Cells(2, basic_data.UsedRange.Find("初始时间").Column))
       Else
         up_data.Cells(I, up_data.UsedRange.Find("计算时间").Column).Value = VBA.DateAdd("d", basic_data.Cells(row_start, col_cur), basic_data.Cells(2, basic_data.UsedRange.Find("初始时间").Column))
       End If
       up_data.Cells(I, up_data.UsedRange.Find("时间点").Column).Value = basic_data.Cells(row_start, col_cur) & point_type
       batch = basic_data.Cells(2, basic_data.UsedRange.Find("批号").Column)
       up_data.Cells(I, up_data.UsedRange.Find("批次").Column).Value = UBound(Split(batch, ";")) + 1
       test_content = ""
       Do While row_cur < row_end
          If basic_data.Cells(row_cur, col_cur) = "√" Then
             If basic_data.Cells(row_cur, col_cur).MergeCells = True Then
                test_content = test_content & basic_data.Cells(row_cur, col_start) & basic_data.Cells(row_cur + 1, col_start) & "、"
             Else
                test_content = test_content & basic_data.Cells(row_cur, col_start) & "、"
             End If
          End If
          row_cur = row_cur + 1
       Loop
       test_content = Left(test_content, Len(test_content) - 1) '去掉最后一个中文顿号
       up_data.Cells(I, up_data.UsedRange.Find("计算内容").Column).Value = test_content
       col_cur = col_cur + 1
       I = I + 1
    Loop
  Else
    MsgBox "没有找到行结束数据，标志是备注："
  End If
End Sub