Excel Vba | ExcelOffice

如何用vba修改excel单元格区域range的行高和列宽？

2018年6月14日作者：exceloffice

暂无评论

range对象中与高度相关的属性有RowHeight和Height，与宽度相关的属性有Width和ColumnWidth 。

其中Height属性可以返回多个单元格区域的总行高，以points为单位，但是它不能设置多个单元格区域的行高。

如果要统一设置多个单元格区域的行高，只能用RowH[……]

阅读全文

如何在vba中编写用任意分隔符合并单元格内容的自定义函数？

2018年6月1日作者：exceloffice

暂无评论

将多个单元格的内容用指定的分隔符合并是一个通用的需求。

以下提供了一个在vba中编写的通用的用任意分隔符合并单元格内容的自定义函数：

Function JoinText(ByVal oRng As Variant, Optional sDelimiter As String = " ")
    Dim arr()
    For Each oCell In oRng
        If Len(oCell) Then
            ReDim Preserve arr(K)
            arr(K) = oCell
            K = K + 1
        End If
    Next
    JoinText = Join(arr, sDelimiter)
End Function

1

2

3

4

5

6

7

8

9

10

11

Function JoinText(ByVal oRng As Variant, Optional sDelimiter As String = " ")

Dim arr()

For Each oCell In oRng

If Len(oCell) Then

ReDim Preserve arr(K)

arr(K) = oCell

K = K + 1

End If

End Function

其中参数oRng可以是excel单元格区域，也可以是excel数组， sDelimiter[……]

阅读全文

如何写vba根据任意选择的字段名拆分工作表数据？

2018年5月21日作者：exceloffice

暂无评论

将单元格区域的数据按照某个字段进行拆分，是一个经常需要遇到的问题。

以下代码利用字典按照任意字段拆分单元格区域的数据，同时将拆分后的数据单独另存为一个excel工作簿。

Sub QQ1722187970()
    Dim oRng As Range
    Dim oRngHead As Range
    Set oRng = Application.InputBox("请选择要拆分的字段名", "拆分", , , , , , 8)
    Excel.Application.ScreenUpdating = False
    Excel.Application.DisplayAlerts = False
    Excel.Application.Calculation = xlCalculationManual
    If oRng.Columns.Count > 1 Then
        MsgBox "您未选择或者您选择的拆分字段有误,请重新选择"
    Else
        Dim oWK As Worksheet
        Dim oDic As Object
        Set oDic = CreateObject("scripting.dictionary")
        With oRng
            Set oWK = .Parent
            iRow = .CurrentRegion.Rows(1).Row
            iColField = .Column
            With oWK
                iRowEnd1 = .Cells(65536, iColField).End(xlUp).Row
                iColEnd = .Cells(iRow, 256).End(xlToLeft).Column
                iColStart = .Cells(iRow, iColField).End(xlToLeft).Column
                iRowEnd2 = .Cells(65536, iColStart).End(xlUp).Row
                Set oRngHead = .Cells(iRow, iColStart).Resize(1, iColEnd - iColStart + 1)
                For i = iRow + 1 To Excel.Application.WorksheetFunction.Max(iRowEnd1, iRowEnd2)
                    Dim oRngTemp As Range
                    Set oRngTemp = .Cells(i, iColStart).Resize(1, iColEnd - iColStart + 1)
                    sText = .Cells(i, iColField).Value
                    If Not oDic.Exists(sText) Then
                        oDic.Add sText, oRngTemp
                    Else
                        Set oDic.Item(sText) = Excel.Application.Union(oDic.Item(sText), oRngTemp)
                    End If
                Next i
                arrKeys = oDic.keys
                arrItems = oDic.items
                For i = 0 To UBound(arrItems)
                    Dim oWB As Workbook
                    Set oWB = Excel.Application.Workbooks.Add
                    With oWB
                        Dim oWK1 As Worksheet
                        Set oWK1 = .Sheets(1)
                        With oWK1
                            oRngHead.Copy .Range("a1")
                            arrItems(i).Copy .Range("a2")
                            .Columns.AutoFit
                        End With
                        .SaveAs Excel.ThisWorkbook.Path & "\" & arrKeys(i), xlOpenXMLWorkbook
                        .Close
                    End With
                Next i
            End With
        End With
    End If
    Excel.Application.Calculation = xlCalculationAutomatic
    Excel.Application.DisplayAlerts = True
    Excel.Application.ScreenUpdating = True
End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

Sub QQ1722187970()

Dim oRng As Range

Dim oRngHead As Range

Set oRng = Application.InputBox("请选择要拆分的字段名", "拆分", , , , , , 8)

Excel.Application.ScreenUpdating = False

Excel.Application.DisplayAlerts = False

Excel.Application.Calculation = xlCalculationManual

If oRng.Columns.Count > 1 Then

MsgBox "您未选择或者您选择的拆分字段有误,请重新选择"

Else

Dim oWK As Worksheet

Dim oDic As Object

Set oDic = CreateObject("scripting.dictionary")

With oRng

Set oWK = .Parent

iRow = .CurrentRegion.Rows(1).Row

iColField = .Column

With oWK

iRowEnd1 = .Cells(65536, iColField).End(xlUp).Row

iColEnd = .Cells(iRow, 256).End(xlToLeft).Column

iColStart = .Cells(iRow, iColField).End(xlToLeft).Column

iRowEnd2 = .Cells(65536, iColStart).End(xlUp).Row

Set oRngHead = .Cells(iRow, iColStart).Resize(1, iColEnd - iColStart + 1)

For i = iRow + 1 To Excel.Application.WorksheetFunction.Max(iRowEnd1, iRowEnd2)

Dim oRngTemp As Range

Set oRngTemp = .Cells(i, iColStart).Resize(1, iColEnd - iColStart + 1)

sText = .Cells(i, iColField).Value

If Not oDic.Exists(sText) Then

oDic.Add sText, oRngTemp

Else

Set oDic.Item(sText) = Excel.Application.Union(oDic.Item(sText), oRngTemp)

End If

Next i

arrKeys = oDic.keys

arrItems = oDic.items

For i = 0 To UBound(arrItems)

Dim oWB As Workbook

Set oWB = Excel.Application.Workbooks.Add

With oWB

Dim oWK1 As Worksheet

Set oWK1 = .Sheets(1)

With oWK1

oRngHead.Copy .Range("a1")

arrItems(i).Copy .Range("a2")

.Columns.AutoFit

End With

.SaveAs Excel.ThisWorkbook.Path & "\" & arrKeys(i), xlOpenXMLWorkbook

.Close

End With

Next i

End With

End If

Excel.Application.Calculation = xlCalculationAutomatic

Excel.Application.DisplayAlerts = True

Excel.Application.ScreenUpdating = True

End Sub

如何在vba中将单元格的文本地址转换为range对象？

2018年5月20日作者：exceloffice

暂无评论

在如何在vba中返回单元格Range对象的地址？一文中我们介绍了如何返回单元格的地址。

相反地，我们也会遇到需要把单元格地址转换为单元格Range对象。

vba中提供了Application对象的Evaluate方法可以直接把正确的单元格地址转换为单元格Range对象。

代码如下：[……]

阅读全文

如何在vba中返回单元格Range对象的地址？

2018年5月20日作者：exceloffice

暂无评论

在编写vba解决方案时，有时候会遇到需要获得单元格的地址。

在vba中可以使用range对象的Address属性，它的语法如下：

expression . Address( RowAbsolute , ColumnAbsolute , ReferenceStyle , External , RelativeTo )

1	expression . Address( RowAbsolute , ColumnAbsolute , ReferenceStyle , External , RelativeTo )

它的5个参数都是可选的，其中RowAbsolute , ColumnAbsolute参数默认为[……]

阅读全文

为什么在vba中使用Application.InputBox无法选择单元格区域？

2018年5月17日作者：exceloffice

暂无评论

Application.InputBox 方法可以弹出选择对话框，选择单元格区域。

但是如果在vba代码中设置了Excel.Application.ScreenUpdating = False 则会导致无法选择单元格区域。

如果要设置Excel.Application.ScreenUpd[……]

阅读全文

如何在vba中求最大值？

2018年5月17日作者：exceloffice

暂无评论

vba的内置函数或语句里没有求最大值的函数。

但是excel单元格函数中有max函数可以求最大值。

通过如何在vba中调用excel工作表函数？一文，我们可以通过在vba中调用excel工作表函数max来实现求最大值的目的。

代码如下：
[crayon-5b302043b2b50[……]

阅读全文

如何用vba将多个工作表另存为独立的工作簿文件？

2018年5月17日作者：exceloffice

暂无评论

当用鼠标右键单击工作表名称标签，在弹出的快捷菜单中选择“移动或者复制”命令，在弹出的“移动或者复制工作表”对话框中可以选择将工作表移动到当前工作簿中的任意一个工作表的位置之前或之后，也可以将工作表移动到一个新的空白工作簿。

在vba中，Worksheet对象的Copy方法可以实现以上的功能。[……]

阅读全文

如何返回当前excel应用程序的版本号？

2018年3月21日作者：exceloffice

暂无评论

在某些情景，我们需要知道excel的版本号。

vba提供了一个快速获取当前excel应用程序的版本号的方法，即使用Application对象的Version属性获取当前excel应用程序的版本号。

Sub QQ1722187970()
 MsgBox Excel.Application.Version
End Sub

1

2

3

Sub QQ1722187970()

MsgBox Excel.Application.Version

End Sub

如何在excel根据某个字段合并同类项，文本内容串联，数值内容求和？

2018年3月19日作者：exceloffice

暂无评论

在excel根据某个字段合并同类项是一个经常会碰到的问题。

如果合并同类项后，其余字段只是简单的累加或者计数或者计算平均值等，在excel中可以使用“合并计算”或者“数据透视表”功能来实现。

如果合并同类项后，其余字段还涉及字符的串联，则需要用vba来实现。

以下代码是一个通用的根[……]

阅读全文

如何用vba修改excel单元格区域range的行高和列宽？

如何在vba中编写用任意分隔符合并单元格内容的自定义函数？

如何写vba根据任意选择的字段名拆分工作表数据？

如何在vba中将单元格的文本地址转换为range对象？

如何在vba中返回单元格Range对象的地址？

为什么在vba中使用Application.InputBox无法选择单元格区域？

如何在vba中求最大值？

如何用vba将多个工作表另存为独立的工作簿文件？

如何返回当前excel应用程序的版本号？

如何在excel根据某个字段合并同类项，文本内容串联，数值内容求和？

分类目录

近期文章

功能