【EXCEL_VBA_基础知识】05-06 使用VBA操作单元格对象

课程来源：王佩丰老师的《王佩丰学VBA视频教程》，如有侵权，请联系删除！

第05课以及第06课，主要讲述VBA如何操作单元格对象（赋值、复制粘贴）

其他小知识点：Call（函数调用）、Range.End（单元格边界）

目录

1. 单元格对象常用操作

2. 单元格对象常用属性

3. 实例应用

3.1 Resize + Merge 合并单元格

3.2 Offset偏移（赋值 或 判断）

3.3 不重名新建工作表（表名在A列）

3.4 将数据拆分到多表（特定列）

3.5  交互式拆分工作表（自由选取第几列 - 拆分字段）

3.6 合并多个工作表

4. 其他小知识点

4.1 单元格边界及应用

---

1. 单元格对象常用操作

2. 单元格对象常用属性

3. 实例应用

3.1 Resize + Merge 合并单元格

Sub Merge()

Dim rng As Range

For Each rng In Range("A1:O1")

    '以选定单元格为基准，合并向下2行，向右1列单元格
    rng.Resize(2, 1).Merge
    
Next

End Sub

3.2 Offset偏移（赋值 或 判断）

Range("a1").Offset(10, 0) = 1 'A11单元格 = 1

3.3 不重名新建工作表（表名在A列）

Sub Create_Sheets()
' 不重名新建工作表

Dim sheet As Worksheet
Dim i, k, irow As Integer

irow = Sheets("数据").Range("a65536").End(xlUp).Row '数据工作表的总行数

For i = 1 To irow

    k = 0 ' 标志位置0

    For Each sheet In Sheets
        If sheet.Name = Sheets("数据").Range("a" & i) Then
            k = 1
        End If
    Next
    
    
    If k = 0 Then
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheets("数据").Range("a" & i)
    End If

Next

End Sub

3.4 将数据拆分到多表（特定列）

Sub 工作表拆分()
'全部行扫描一次即可完成拆分
' 按照第4列（D列）字段拆分

Call 清空结果 '清空其他表格

Dim i, j As Integer

For i = 2 To Sheet1.Range("a65535").End(xlUp).Row 
'遍历每一行数据直到最后一行
    
    '目标工作表的第一行空行行号
    j = Sheets(Sheet1.Range("d" & i).Value).Range("a65535").End(xlUp).Row + 1 
    
    '数据复制到目标工作表的第一行空行
    Sheet1.Range("a" & i).EntireRow.Copy Sheets(Sheet1.Range("d" & i).Value).Range("a" & j) 
Next

End Sub

Sub 清空结果()
Dim sht As Worksheet
For Each sht In Worksheets
    
    If sht.Name <> "数据" Then sht.Range("a2:f10000").ClearContents

Next


End Sub

3.5  交互式拆分工作表（自由选取第几列 - 拆分字段）

Sub 表格拆分()


Dim sheet As Worksheet
Dim i, j, k As Integer
Dim irow As Integer '一共多少行
Dim coloum As Integer '拆分字段


coloum = InputBox("请输入你要按哪列分") ' 获取拆分字段

' sheets("数据") 代表 sheets("数据")
irow = Sheets("数据").Range("a65536").End(xlUp).Row '数据工作表的总行数


'删除无意义的表
Application.DisplayAlerts = False '不显示警告框

For Each sheet In Sheets
    If sheet.Name <> "数据" Then
         sheet.Delete
    End If
Next

Application.DisplayAlerts = True '显示警告框


'拆分表
For i = 2 To irow

    k = 0 ' 标志位，0代表无重复表
    
    For Each sheet In Sheets
    
        'Cells(i, coloum)代表i行coloum列单元格
        If sheet.Name = Sheets("数据").Cells(i, coloum) Then
            k = 1
        End If
        
    Next
        
    If k = 0 Then
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheets("数据").Cells(i, coloum)
    End If

Next


'拷贝数据

For j = 2 To Sheets.Count
    Sheets("数据").Range("a1:f" & irow).AutoFilter Field:=coloum, Criteria1:=Sheets(j).Name
    Sheets("数据").Range("a1:f" & irow).Copy Sheets(j).Range("a1")
Next

Sheets("数据").Range("a1:f" & irow).AutoFilter

Sheets("数据").Select

MsgBox "已处理完毕"

End Sub

3.6 合并多个工作表

Sub 合并多个表格()
Dim i, j As Integer   'i是数据源表的最后一行，j是目标表(数据表)的最后一行
Dim sheet As Worksheet
Dim irow, icoloum As Integer '表头的列数和行数

irow = InputBox("表头有几行")
icoloum = InputBox("表头有几列")


'先要删除所有数据
Sheets("数据").Range("a1:f65536").ClearContents

'复制表头
Sheet2.Range("A1").Resize(irow, icoloum).Copy Sheets("数据").Range("a1")

'复制数据
For Each sheet In Sheets
    If sheet.Name <> "数据" Then
        i = sheet.Range("a65536").End(xlUp).Row '数据源表的最后一行
        j = Sheets("数据").Range("a65536").End(xlUp).Row 'j是目标表(数据表)的最后一行
        
        sheet.Range("a" & irow + 1).Resize(i - irow, icoloum).Copy Sheets("数据").Range("a" & j + 1)
    End If
Next
End Sub

4. 其他小知识点

4.1 单元格边界及应用