通过两个字段对数据进行分类编组

W_noteless

已于 2022-07-29 16:32:06 修改

阅读量696

点赞数

文章标签： microsoft

于 2022-07-29 08:47:20 首次发布

本文链接：https://blog.csdn.net/W_noteless/article/details/126047916

版权

这篇博客介绍了一种使用Visual Basic for Applications (VBS)脚本来自动化处理Excel数据的方法。具体操作包括根据第二列和第六列的内容对数据进行分类和重新编码，同时对结果进行排序和填充。用户需要输入起始编号，并且脚本每秒可以处理约36条记录，对于大量数据的处理非常高效。

摘要由CSDN通过智能技术生成

##通过两个字段对数据进行分类编组

在Excel中有时需要根据两个字段合并生成一信息的时候。需要人工将进行字段合并，操作起来比较麻烦也容易出错。如下图：将编码中编组相同的记录进行重新编码。

处理后效果如图
在这里插入图片描述
一、操作说明：
1、Excel文件放置到D盘excel文件夹中，内容放Sheet1。
2、第一行为标题，第二列为地点码，第六列为本地试管ID，每7，8，9列留空，准备写入数据。
3、Excel需要根据第二列(第一关键字)和第六列（第二关键字）排序。
4、第7行的信息是在本组的编号和组编号

三、代码：（VBS）
以下脚本写入文本文件，存储为扩展名为.vbs的文件。打开即是运行。
处理效率：每秒36条左右。万条5分钟左右。
技术要点：使用VBS操作Excel文件操作，单元格读写，合并，背景填充。
注意：计算机必须安装Office，运行过程会提示输入起始号。然后无任何信息，最后Excel打开。转换结束。
操作如图：

在这里插入图片描述

代码如下：

Set objExcelApp = CreateObject("Excel.Application")

dim sheetname
dim start_ID
dim str_area,str_ID,new_ID
dim curr_row,prev_row
dim color_ID
dim count_num,count_total

objExcelApp.Workbooks.Open "d:\\excel\\data.xlsx"
sheetname =  "Sheet1"

objExcelApp.Worksheets(sheetname).Activate


start_ID="100001"
count_total=1
count_num=1

curr_row=2
prev_row=2
color_ID=6

str_area=objExcelApp.Worksheets(sheetname).cells(2,2).value
str_ID=objExcelApp.Worksheets(sheetname).cells(2,6).value
new_ID=start_ID
new_ID=inputbox("请输入起始编号：","提示信息",start_ID)


objExcelApp.Worksheets(sheetname).cells(curr_row,8).value=objExcelApp.Worksheets(sheetname).cells(curr_row,2).value+right(new_ID,5)
while (objExcelApp.Worksheets(sheetname).cells(curr_row,2).value<>"")


	if(str_area<>objExcelApp.Worksheets(sheetname).cells(curr_row,2).value) then
		new_ID=start_ID
		new_ID=inputbox("请输入" & objExcelApp.Worksheets(sheetname).cells(curr_row,2).value & "起始编号：","提示信息",start_ID)

		objExcelApp.Worksheets(sheetname).Range(objExcelApp.Worksheets(sheetname).Cells(curr_row-1, 8), objExcelApp.Worksheets(sheetname).Cells(prev_row, 8)).Merge
		objExcelApp.Worksheets(sheetname).cells(curr_row,8).value=objExcelApp.Worksheets(sheetname).cells(curr_row,2).value+right(new_ID,5)
		prev_row=curr_row
		count_total=count_total+1
		count_num=1
		if color_ID=6 then color_ID=14 else color_ID=6 end if
	else
		if(str_ID<>objExcelApp.Worksheets(sheetname).cells(curr_row,6).value) then 
			new_ID=new_ID+1
			objExcelApp.Worksheets(sheetname).Range(objExcelApp.Worksheets(sheetname).Cells(curr_row-1, 8), objExcelApp.Worksheets(sheetname).Cells(prev_row, 8)).Merge
			objExcelApp.Worksheets(sheetname).cells(curr_row,8).value=objExcelApp.Worksheets(sheetname).cells(curr_row,2).value+right(new_ID,5)
			count_num=1
			prev_row=curr_row
			count_total=count_total+1
			if color_ID=6 then color_ID=14 else color_ID=6 end if
		end if 

	end if 

	objExcelApp.Worksheets(sheetname).rows(curr_row).Interior.colorindex=color_ID
	objExcelApp.Worksheets(sheetname).cells(curr_row,7).value=new_ID
	objExcelApp.Worksheets(sheetname).cells(curr_row,9).value=count_num & "_" & count_total
	str_area=objExcelApp.Worksheets(sheetname).cells(curr_row,2).value
	str_ID=objExcelApp.Worksheets(sheetname).cells(curr_row,6).value
	count_num=count_num+1
	curr_row=curr_row+1
wend

objExcelApp.Worksheets(sheetname).Range(objExcelApp.Worksheets(sheetname).Cells(curr_row-1, 8), objExcelApp.Worksheets(sheetname).Cells(prev_row, 8)).Merge
objExcelApp.Visible = true