# Excel2019宏的应用之表格合并-中标数据处理

Excel2019

Sub 中标数据处理()
Dim rng As Range, sht As Worksheet
Start = Timer
'新建一个工作表，名称为：be_yaopinzhongbiao
'填写字段
[A1] = "me_uid"
[B1] = "me_name"
[c1] = "me_brandname"
[D1] = "me_jixing"
[E1] = "me_guige"
[F1] = "me_guifanguige"
[G1] = "me_baozhuanguige"
[H1] = "me_baozhuanguige2"
[I1] = "me_packaging"
[J1] = "me_feiyong"
[K1] = "me_categ"
[L1] = "me_status"
[M1] = "me_qlevel"
[n1] = "me_shengchanqiye"
[O1] = "me_bidder"
[P1] = "me_first"
[Q1] = "me_firstyingwen"
[r1] = "me_approvaldate"
[S1] = "me_remarks1"
[T1] = "me_remarks2"
[U1] = "me_source"
[v1] = "me_down"
[W1] = "me_remarks3"
'循环工作表，当名称不等于be_yaopinzhongbiao时进行判断和复制，粘贴到be_yaopinzhongbiao表对应位置
For Each sht In Sheets
If sht.Name <> "be_yaopinzhongbiao" Then
'获取使用区域的最大行号
For Each rng In sht.Range("A1:W1")
If rng = "me_name" Then
cl = rng.Column
Exit For '退出当前循环（可省）
End If
Next
i = sht.Cells(Rows.Count, cl).End(xlUp).Row '原表中行号
hi = Sheets("be_yaopinzhongbiao").Range("B" & Rows.Count).End(xlUp).Row
'判断对应列
For Each rng In sht.Range("A1:W1")
'复制药品通用名
If rng = "me_name" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("B" & hi + 1)
End If
'复制商品名
If rng = "me_brandname" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("C" & hi + 1)
End If
'复制剂型
If rng = "me_jixing" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("D" & hi + 1)
End If
'复制规格
If rng = "me_guige" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("E" & hi + 1)
End If
'复制规范规格
If rng = "me_guifanguige" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("F" & hi + 1)
End If
'复制包装转换比
If rng = "me_baozhuanguige" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("G" & hi + 1)
End If
'复制规范包装转换比
If rng = "me_baozhuanguige2" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("H" & hi + 1)
End If
'复制单位
If rng = "me_packaging" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("I" & hi + 1)
End If
'复制中标价
If rng = "me_feiyong" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("J" & hi + 1)
End If
'复制分类
If rng = "me_categ" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("K" & hi + 1)
End If
'复制状态
If rng = "me_status" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("L" & hi + 1)
End If
'复制质量层次
If rng = "me_qlevel" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("M" & hi + 1)
End If
'复制生产企业
If rng = "me_shengchanqiye" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("N" & hi + 1)
End If
'复制投标企业
If rng = "me_bidder" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("O" & hi + 1)
End If
'复制省份
If rng = "me_first" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("P" & hi + 1)
End If
'复制英省份名
If rng = "me_firstyingwen" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("Q" & hi + 1)
End If
'复制发布日期
If rng = "me_approvaldate" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("R" & hi + 1)
End If
'复制备注1
If rng = "me_remarks1" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("S" & hi + 1)
End If
'复制备注2
If rng = "me_remarks2" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("T" & hi + 1)
End If
'复制来源文件
If rng = "me_source" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("U" & hi + 1)
End If
'复制链接
If rng = "me_down" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("V" & hi + 1)
End If
'复制备注3
If rng = "me_remarks3" Then
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("W" & hi + 1)
End If

'工作表名
[x1] = "me_sheet"
Sheets("be_yaopinzhongbiao").Range("x" & hi + 1).Resize(i - 2, 1) = sht.Name
Next

End If
Next
'设置字体字号格式
With Sheets("be_yaopinzhongbiao").Cells.Font
.Name = "等线"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.ColorIndex = xlAutomatic
.ThemeFont = xlThemeFontMinor
End With
'边框和底纹
With Sheets("be_yaopinzhongbiao").Cells.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With Sheets("be_yaopinzhongbiao").Cells.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With

With Sheets("be_yaopinzhongbiao").Cells.Interior
.Pattern = xlNone
End With

MsgBox ("处理完毕！用时" & Format(Timer - Start, "0.00") & "秒")
End Sub

Sub 新中标数据处理()
Dim rng As Range, sht As Worksheet
Start = Timer
'新建一个工作表，名称为：be_yaopinzhongbiao
'填写字段
[A1] = "me_uid"
[B1] = "me_name"
[c1] = "me_brandname"
[D1] = "me_jixing"
[E1] = "me_guige"
[F1] = "me_guifanguige"
[G1] = "me_baozhuanguige"
[H1] = "me_baozhuanguige2"
[I1] = "me_packaging"
[J1] = "me_feiyong"
[K1] = "me_categ"
[L1] = "me_status"
[M1] = "me_qlevel"
[n1] = "me_shengchanqiye"
[O1] = "me_bidder"
[P1] = "me_first"
[Q1] = "me_firstyingwen"
[r1] = "me_approvaldate"
[S1] = "me_remarks1"
[T1] = "me_remarks2"
[U1] = "me_source"
[v1] = "me_down"
[W1] = "me_remarks3"
'循环工作表，当名称不等于be_yaopinzhongbiao时进行判断和复制，粘贴到be_yaopinzhongbiao表对应位置
For Each sht In Sheets
If sht.Name <> "be_yaopinzhongbiao" Then
'获取使用区域的最大行号
For Each rng In sht.Range("A1:W1")
If rng = "me_name" Then
cl = rng.Column
Exit For '退出当前循环（可省）
End If
Next
i = sht.Cells(Rows.Count, cl).End(xlUp).Row '原表中行号
hi = Sheets("be_yaopinzhongbiao").Range("B" & Rows.Count).End(xlUp).Row
'判断对应列
For Each rng In sht.Range("A1:W1")

Select Case rng
'复制药品通用名
Case "me_name"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("B" & hi + 1)

'复制商品名
Case "me_brandname"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("C" & hi + 1)

'复制剂型
Case "me_jixing"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("D" & hi + 1)

'复制规格
Case "me_guige"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("E" & hi + 1)

'复制规范规格
Case "me_guifanguige"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("F" & hi + 1)

'复制包装转换比
Case "me_baozhuanguige"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("G" & hi + 1)

'复制规范包装转换比
Case "me_baozhuanguige2"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("H" & hi + 1)

'复制单位
Case "me_packaging"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("I" & hi + 1)

'复制中标价
Case "me_feiyong"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("J" & hi + 1)

'复制分类
Case "me_categ"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("K" & hi + 1)

'复制状态
Case "me_status"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("L" & hi + 1)

'复制质量层次
Case "me_qlevel"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("M" & hi + 1)

'复制生产企业
Case "me_shengchanqiye"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("N" & hi + 1)

'复制投标企业
Case "me_bidder"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("O" & hi + 1)

'复制省份
Case "me_first"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("P" & hi + 1)

'复制英省份名
Case "me_firstyingwen"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("Q" & hi + 1)

'复制发布日期
Case "me_approvaldate"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("R" & hi + 1)

'复制备注1
Case "me_remarks1"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("S" & hi + 1)

'复制备注2
Case "me_remarks2"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("T" & hi + 1)

'复制来源文件
Case "me_source"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("U" & hi + 1)

'复制链接
Case "me_down"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("V" & hi + 1)

'复制备注3
Case "me_remarks3"
rng.Offset(2, 0).Resize(i - 2, 1).Copy Sheets("be_yaopinzhongbiao").Range("W" & hi + 1)

'工作表名
[x1] = "工作表名"
Sheets("be_yaopinzhongbiao").Range("x" & hi + 1).Resize(i - 2, 1) = sht.Name

End Select
Next
End If
Next

'设置字体字号格式
With Sheets("be_yaopinzhongbiao").Cells.Font
.Name = "等线"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.ColorIndex = xlAutomatic
.ThemeFont = xlThemeFontMinor
End With
'边框和底纹
With Sheets("be_yaopinzhongbiao").Cells.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With Sheets("be_yaopinzhongbiao").Cells.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With

With Sheets("be_yaopinzhongbiao").Cells.Interior
.Pattern = xlNone
End With

MsgBox ("处理完毕！用时" & Format(Timer - Start, "0.00") & "秒")
End Sub