Sub NextSeven_CodeFrame()
'应用程序设置
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual '错误处理
On Error GoTo ErrHandler '计时器
Dim StartTime, UsedTime As Variant
StartTime = VBA.Timer '变量声明
Dim Wb As Workbook
Dim Sht As Worksheet
Dim OpenWb As Workbook
Dim oSht As Worksheet
Dim i&, j& Dim Rng As Range
Dim Arr As Variant
Dim EndRow As Long
Dim RowCount As Long
Dim ColCount As Long Dim FilePath As String '实例化对象
Set Wb = Application.ThisWorkbook '选取单个文件
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.InitialFileName = Wb.Path '指定初始化路径
.Filters.Clear
.Filters.Add "Excel文件", "*.xls;*.xlsx"
If .Show = -1 Then
FilePath = .SelectedItems(1)
Else
Exit Sub
End If
End With Set OpenWb = Application.Workbooks.Open(FilePath)
Set oSht = OpenWb.Worksheets(1)
With oSht
Set Rng = Application.Intersect(.UsedRange.Offset(1), .UsedRange)
RowCount = Rng.Rows.Count
ColCount = Rng.Columns.Count
Arr = Rng.Value
For i = LBound(Arr) To UBound(Arr)
'长数字加单引号
Arr(i, 2) = "'" & Arr(i, 2)
Arr(i, 10) = "'" & Arr(i, 10)
Arr(i, 14) = "'" & Arr(i, 14)
Arr(i, 15) = "'" & Arr(i, 15)
Arr(i, 18) = "'" & Arr(i, 18)
'转置关系
Arr(i, 20) = Arr(i, 2)
Arr(i, 2) = Arr(i, 1)
Arr(i, 1) = "" Next i
End With
OpenWb.Close False Set Sht = Wb.Worksheets(1)
With Sht
.UsedRange.Offset(6).Clear '预先清除
Set Rng = .Range("A7").Resize(RowCount, ColCount)
Rng.Value = Arr '导入内容
End With Dim RowStart As Object
Dim RowsCount As Object
Dim Key As String
Dim OneKey As Variant
Set RowStart = CreateObject("scripting.dictionary")
Set RowsCount = CreateObject("scripting.dictionary") MergeColumnNo = 2 '关键字所在列 For i = LBound(Arr, 1) To UBound(Arr, 1)
Key = CStr(Arr(i, MergeColumnNo))
If RowStart.Exists(Key) = False Then
RowStart(Key) = i
RowsCount(Key) = 1
Else
RowsCount(Key) = RowsCount(Key) + 1
End If
Next i MergeCols = Array("A", "B", "D", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Z") '合并列
For Each OneKey In RowStart.Keys
For n = LBound(MergeCols) To UBound(MergeCols)
Rng.Cells(RowStart(OneKey), MergeCols(n)).Resize(RowsCount(OneKey), 1).Merge
Next n
Next OneKey Const HeadRow As Long = 6
Dim Index As Long
With Sht
EndRow = .Cells(.Cells.Rows.Count, 2).End(xlUp).Row
Index = 0
For i = HeadRow + 1 To EndRow
If .Cells(i, 2).Value <> "" Then
Index = Index + 1
.Cells(i, 1).Value = Index
End If
Next i
End With SetEdges Rng
CustomFormat Rng
Union(Sht.Range("A6:Z6"), Rng).Columns.AutoFit '运行耗时
UsedTime = VBA.Timer - StartTime
MsgBox "本次运行耗时:" & Format(UsedTime, "0.0000000秒") & "——NextSeven竭诚为您服务。"
ErrorExit: '错误处理结束,开始环境清理
Set Wb = Nothing
Set OpenWb = Nothing
Set Sht = Nothing
Set oSht = Nothing
Set Rng = Nothing Set RowStart = Nothing
Set RowsCount = Nothing Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
ErrHandler:
If Err.Number <> 0 Then
MsgBox Err.Description & "!", vbCritical, "错误提示!"
'Debug.Print Err.Description
Err.Clear
Resume ErrorExit
End If
End Sub
Sub CustomFormat(ByVal Rng As Range)
With Rng
.Font.Name = "宋体"
.Font.Size = 10
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End Sub

  

20161212xlVBA工作表数据整理合并单元格的更多相关文章

  1. Aspose.Cells 首次使用,用到模版填充数据,合并单元格,换行

    Aspose.Cells 首次使用,用到模版填充数据,合并单元格,换行 模版格式,图格式是最简单的格式,但实际效果不是这种,实际效果图如图2 图2 ,注意看红色部分,一对一是正常的,但是有一对多的订单 ...

  2. 雷林鹏分享:jQuery EasyUI 数据网格 - 合并单元格

    jQuery EasyUI 数据网格 - 合并单元格 数据网格(datagrid)经常需要合并一些单元格.本教程将向您展示如何在数据网格(datagrid)中合并单元格. 为了合并数据网格(datag ...

  3. js动态加载数据并合并单元格

    js动态加载数据合并单元格, 代码如下所示,可复制直接运行: <!DOCTYPE HTML> <html lang="en-US"> <head> ...

  4. 【Excle数据透视表】如何在数据透视表中使用合并单元格标志

    先有数据透视表如下: 现在看着这个格式不舒服,我们希望调整成如下这种样式 步骤 单击数据透视表任意单元格→右键→数据透视表选项→布局和格式→合并且居中排列带标签的单元格 注意:如果数据透视表报表布局不 ...

  5. Apache POI 合并单元格

    合并单元格所使用的方法: sheet.addMergedRegion( CellRangeAddress  cellRangeAddress  );   CellRangeAddress  对象的构造 ...

  6. BootStrap Table 合并单元格

    为了更直观展示表格的一大堆乱七八糟的数据,合并单元格就派上用场: 效果: 贴上JSON数据(后台查询数据一定要对合并字段排序): [ { "city": "广州市&quo ...

  7. Apache POI 合并单元格--简单解释版带Demo

    合并单元格所使用的方法: sheet.addMergedRegion( CellRangeAddress  cellRangeAddress  );   CellRangeAddress  对象的构造 ...

  8. 议:如何将树形菜单形式的数据转化成HTML的二维表(相同内容需合并单元格)

    一般做OA类管理系统,经常涉及到“组织架构”的概念,那么像这种有上下层级关系的数据一般会做成树形菜单的方式显示,底层代码必定会用到递归算法.这篇随笔的目的就是要谈谈除了用树形菜单来显示这种上下层级关系 ...

  9. layui:数据表格如何合并单元格

    layui.use('table', function () { var table = layui.table; table.render({ elem: '#applyTab' , url: '$ ...

随机推荐

  1. Pointofix 1.7 Portable试用

    Pointofix 1.7 Portable简体中文单文件便携版 软件大小:347K软件语言:简体中文软件类别:国外软件/桌面工具/教育教学运行环境:windows XP/Vista/Win7开 发 ...

  2. Python: yield, python 实现tail -f

    def CreateGenerator(file): with open(file,'r') as t: t.seek(0,2) while True: line=t.readline() if no ...

  3. Linux其他: GitBash

    git bash是Windows下的命令行工具 安装后在任何一个文件夹下右键GitBash,打开一个窗口,ssh root@xx.xxx.xxx.xx登陆到服务器,输入yes,和登陆密码可以使用敲命令 ...

  4. linux常用命令:top 命令

    top命令是Linux下常用的性能分析工具,能够实时显示系统中各个进程的资源占用状况,类似于Windows的任务管理器.下面详细介绍它的使用方法.top是 一个动态显示过程,即可以通过用户按键来不断刷 ...

  5. python的数据结构之数字和字符串(四)

    一.数字 Python Number 数据类型用于存储数值.数据类型是不允许改变的,这就意味着如果改变 Number 数据类型的值,将重新分配内存空间. Python 支持四种不同的数值类型: 整型( ...

  6. 借助IDE到处Runnable JAR 的步骤

    1. 选择项目,右键,export,选择Java目录下的Runnable JAR file , next 2. Lanch configuration 中选择启动类 3. Export destina ...

  7. $.ajax({ }) 里面的success函数不执行 | 回调函数返回的值 用对象,下标,键值对访问不到时

    原因一般是  dataType:'json' 数据类型设置成了json  ,去掉这个设置即可 $.ajax({ }) 回调函数返回的值 用对象,下标,键值对访问不到时,考虑是否返回数据为字符串 考虑是 ...

  8. iOS原生的AVFoundation扫描二维码/条形码

    #import <AVFoundation/AVFoundation.h> @interface ViewController ()<AVCaptureMetadataOutputO ...

  9. MySQL Crash Course #11# Chapter 20. Updating and Deleting Data

    INDEX Updating Data The IGNORE Keyword Deleting Data Faster Deletes Guidelines for Updating and Dele ...

  10. 20145322 Exp5 Adobe阅读器漏洞攻击

    20145322 Exp5 Adobe阅读器漏洞攻击 实验过程 IP:kali:192.168.1.102 windowsxp :192.168.1.119 msfconsole进入控制台 使用命令为 ...