VBA中 各种数据类型的使用(自定义数据类型Type,数组,数据字典)、读写文件_sun0322的博客-CSDN博客_vba数据字典赋值与读取
目录
17.使用VBA给单元格设置公式 :( FormulaR1C1 )
====
1.各种数据类型
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'*
'* 自定义学生对象
'* 做成时间:2020/01/20
'* 做成者: sun
'* 跟新日:
'* 更新者:
'*
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Type STUDENT_INFO
'学号
stuNo As String
stuName As String
stuAge As String
stuSexCode As String
End Type
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'*
'* 定义各种数据类型,处理学生对象情报
'* 做成时间:2020/01/20
'* 做成者: sun
'* 跟新日:
'* 更新者:
'*
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Sub getStudentInfo()
' 从Excel的Sheet页中取得情报 例子
' Dim sheet As Worksheet
' Set sheet = Worksheets("testSheetName")
' cellValue = sheet.Cells(2, 3) '2C 单元格 "1001,张三,30,1、1002,李四,31,1、1003,XiaoHong,29,2"
' MsgBox cellValue
' 全部学生信息 以字符串形式保存
Dim allStudentInfo As String
allStudentInfo = "1001,张三,30,1、1002,李四,31,1、1003,XiaoHong,29,2"
' 全部学生信息 以数组形式保存【数组使用】
Dim studentInfoList() As String
studentInfoList = Split(allStudentInfo, "、")
' 全部学生姓名信息 以key-学号 value-姓名 的Map形式保存
Dim studentDataList As Object '【数据字典使用-定义】
Set studentDataList = CreateObject("Scripting.Dictionary")
' UBound 返回数组的上界 ,★★★不是数组的大小★★★比如数组大小时4,那么上届是3
For i = 0 To UBound(studentInfoList)
' 循环设定每个学生的信息
Dim stuObject As STUDENT_INFO '【自定义数据类型使用】
stuObject = setStudentInfo(studentInfoList(i))
' 以学号作为Key,存储上面设定好的学生的信息
' studentDataList.Add stuObject.stuNo, stuObject '不好用,无法保存自定义对象
studentDataList.Add stuObject.stuNo, stuObject.stuName '【数据字典使用 - 设定值】
Next
' 显示学号是「1002」小明同学的信息
If studentDataList.exists("1002") Then '【数据字典使用 - 取值】
MsgBox studentDataList.Item("1002") '【数据字典使用 - 取值】
End If
End Sub
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'*
'* 设定单个学生对象情报
'* 做成时间:2020/01/20
'* 做成者: sun
'* 跟新日:
'* 更新者:
'*
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Public Function setStudentInfo(studentInfo As String) As STUDENT_INFO
' 单个学生的信息
Dim infos() As String
infos = Split(studentInfo, ",")
' 使用上面定义的学生对象
Dim stuObject As STUDENT_INFO
stuObject.stuNo = infos(0)
stuObject.stuName = infos(1)
stuObject.stuAge = infos(2)
stuObject.stuSexCode = infos(3)
' 设定返回值
setStudentInfo = stuObject
End Function
----
2.VBA定义公共数组(全局都可以使用)
public sqlList
public Function sql_init()
ActiveWorkbook.sheets("sql").Activate
ActiveWorkbook.sheets("sql").Select
var1 = ActiveSheet.Range("C2").value
var2 = ActiveSheet.Range("C3").value
var3 = ActiveSheet.Range("C4").value
sqlList= Array(var1, var2, var3)
End Function
扩展
「プロシージャの外では無効です」错误发生原因
只写了End,而没有写 End Function
----
3.读写文件
ファイルの操作(Shift-JIS/UTF8対応)[ExcelのVBA]
SJIS 写入
Private Sub CommandButton2_Click()
Dim fileNo As Integer ' ファイル番号
' ファイルを開く為のファイル番号を取得
fileNo = FreeFile
' 指定されたファイルを開く(ない場合は作成する)
Open "Sjisの書き込みテスト.txt" For Output As #fileNo
' 一行毎に文字列を書き込む
Print #fileNo, "エクセル講座"
Print #fileNo, "http://www.petitmonte.com/excel/excel.html"
Close #fileNo
End Sub
UTF8 写入
Private Sub CommandButton4_Click()
Dim Stream As Object
' VB標準のADODB.Streamオブジェクトを作成する
Set Stream = CreateObject("ADODB.Stream")
' ストリームの文字コードをUTF8に設定する
Stream.Charset = "UTF-8"
' ファイルのタイプ(1:バイナリ 2:テキスト)
Stream.Type = 2
' ストリームを開く
Stream.Open
' ストリームの保存形式をテキスト形式にする
Stream.WriteText "エクセル講座" & vbCrLf & "http://www.petitmonte.com/excel/excel.html"
' ストリームに名前を付けて保存する(1は新規作成 2は上書き保存)
Stream.SaveToFile ("utf8の書き込みテスト.txt"), 2
' ストリームを閉じる
Stream.Close
Set Stream = Nothing
End Sub
--
读取 SJIS
Option Explicit
Private Sub CommandButton1_Click()
Dim fileNo As Integer ' ファイル番号
Dim buffer As String ' 一時的に文字列を格納
' ファイルを開く為のファイル番号を取得
fileNo = FreeFile
' 指定されたファイルを開く
Open "C:\excel_vba_22_sjis.txt" For Input As #fileNo
' ファイルがEOF(ファイルの終端)になるまでループをする
Do Until EOF(fileNo)
' ファイルから一行づつbufferに読み込む
Line Input #fileNo, buffer
' 読み込んだ一行をイミディエイトに出力
Debug.Print buffer
Loop
Close #fileNo
End Sub
读取 UTF-8
Private Sub CommandButton3_Click()
Dim buffer As String ' 一時的に文字列を格納
Dim Stream As Object
' VB標準のADODB.Streamオブジェクトを作成する
Set Stream = CreateObject("ADODB.Stream")
' ストリームの文字コードをUTF8に設定する
Stream.Charset = "UTF-8"
' ファイルのタイプ(1:バイナリ 2:テキスト)
Stream.Type = 2
' ストリームを開く
Stream.Open
' ストリームにファイルを読み込む
Stream.LoadFromFile ("C:\excel_vba_22_utf8.txt")
' ファイルの中身をbufferへ代入
buffer = Stream.ReadText
' ストリームを閉じる
Stream.Close
' イミディエイトへ出力
Debug.Print buffer
Set Stream = Nothing
End Sub
--
循环读取的每一行文件
循环对象
Sub Adele()
Dim strAll, vArr, i&
。。。
strAll = Stream.ReadText
Stream.Close
vArr = Split(strAll, vbCrLf)
For i = 0 To UBound(vArr)
MsgBox vArr(i)
Next
End Sub
---
4.异常处理
Function
On Error GoTo err_handle
。。。
Exit Function
err_handle:
MsgBox "Error!"
End Function
---
5.忽略错误
Function
On Error resume next
。。。
End Function
resume [rɪˈzjuːm] n. 摘要;简历 v. 重新开始,恢复;取回,重新占用
---
6.其他常用1
根据一览,自动生成Sheet页_sun0322-CSDN博客
7.其他常用2:读取(多个)Excel文件
Excel VBA 循环读取一个目录下面多个文件的内容,放到另外一个文件中_sun0322-CSDN博客_vba循环读取文件夹下的文件
8. ★★★ 各种常用操作总结 ★★★
' 有时即使光标到了A1,因为滚动条的原因,显示效果并不是在最上面,此时要使用下面语句
ActiveWindow.SmallScroll Down:=-2000
' 对公式进行计算
ActiveSheet.Calculate
’多个Excel直接发生切换时,使用下面的语句(参数是,要切换到的Excel的名字,不含路径)
' (对于不是通过代码打开的 Excel文件)
Windows(operateFileName).Activate
' 对于代码打开的Excel,直接使用下面语句即可切换
Set workbook2 = Workbooks.Open("pathAndName", UpdateLinks:=0)
workbook2.Activate
Sheets("xxx").Select
'关闭打开Excel (不保存)
workbook2.Close savechanges:=False
'【sheet】复制
workbook2.Activate
Sheets("copySheet").Select
Sheets("copySheet").Copy After:workbook1.Sheets(10)
'【sheet】重命名
workbook1.Activate
Sheets("copySheet (2)").Select
Sheets("copySheet (2)").Name = copySheet_比較用
'【sheet】删除
Sheets("copySheet_比較用").select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
’【单元格】复制,粘贴
Range("A1:C20").Select
Selection.copy
Range("E1").Select
ActiveSheet.Paste
’【单元格】复制,粘贴 【公式 ⇒ 值】
Rang("A1:C20").Select
Selection.copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
’【单元格】删除指定行 (例:删除11到20行)
Rows("11:20").Select
Selection.Delete Shift:=xlUp
' goto A1 ' 遍历所有Sheet页 ' 保存
Dim sh As Worksheet
For Each sh In ActiveWorkbook.sheets
sh.Activate
sh.Range("A1").Activate
Next
ActiveWorkbook.Sheets(1).Activate
ActiveWorkbook.Save
===
9.事件相关处理 (保存,离开单元格等操作时,触发处理)
指定单元格里面的,内容发生变化,触发事件,调用VBA代码。_sun0322的博客-CSDN博客_单元格变化触发vba
--
10.定义(调用)有返回值的函数
---
' 定义有返回值的函数
public Function checkValue() As Integer
If XXX then
' 设定函数的返回值 ’× :set checkValue = 1
checkValue = 1
Exit Function
End If
checkValue = 0
End Function
' 调用函数
flg = checkValue
If flg <> 0 Then
。。。
End If
---
11.使用VBA操作IE浏览器
VBS操作IE ---(【当不使用IE时】可以使用Chrome插件,自定义JS插件操作浏览器)_sun0322的博客-CSDN博客_vbs 浏览器
12.Variant 变量类型
Private Sub CommandButton1_Click()
'Declare 【Variant】 variable
Dim areaA As Variant
'Set 【Variant variable】Value '可以使用F3中定义的变量
areaA = Range("D6:F9")
'Use the 【Variant】 variable
var1 = areaA(2, 2)
var2 = areaA(4, 3)
MsgBox "var1:" & var1 & Chr(10) & "var2:" & var2
End Sub
--- Variant [ˈveriənt] 变种; 变体; 变形;
---
13.调用bat (使用cmd,直接运行程序)
VBA调用bat,doc 命令行 窗口关闭之后,VBA代码 再继续执行_sun0322的博客-CSDN博客_vba执行bat命令
---
14.调用Jar,并获取返回值
核心代码
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
。。。
cmdStr = "java -jar c:\xxx\xxx\xx\tool.jar param1 param2"
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec(cmdStr)
Dim exitCode
exitCode = oExec.exitCode
' Java ソース中に、正常終了の場合、main関数の最後で、System.exit(666);
' Java ソース中に、異常終了の場合、System.exit(1);
do While exitCode = 0
' 遅延確認したいと、返却値ずっと[0]です。
Sleep 3000
exitCode = oExec.exitCode
Loop
Set oStdOut = oExec.StdOut
具体内容
https://blog.csdn.net/sxzlc/article/details/124742355
===
15.循环(For、While)
For
For i =12 To 150
' 第一次是,【5行,12列】中的数据
cellValue = Cells(5, i).Value
' 空值的时候,退出
IF cellValue = Empty Then
Exit For
End IF
Next
While
i = 2
cellValue = Cells(5, i).Value
Do While cellValue <> Empty
i = i + 1
cellValue = Cells(5, i).Value
Loop
===
16.Excel-VBA:列号与字母(列名)的相互转换
核心代码
addrA1 = Replace(Cells(i, j).Address(0, 0), "1", "")
其它代码
'列号转字母(列名)
Function Num2Name(ByVal ColumnNum As Long) As String
On Error Resume Next
Num2Name = "" '超出范围返回空,如调用Num2Name(100000)
Num2Name = Replace(Cells(1, ColumnNum).Address(0, 0), "1", "")
'Cell.Address用来返回单元格的地址,参数(0,0)返回相对地址A1,参数(1,1)返回绝对地址$A$1
End Function
'字母(列名)转列号
Function Name2Num(ByVal ColumnName As String) As Long
On Error Resume Next
Name2Num = -1 '超出范围返回0,如调用Name2Num("AAAA") ,EXCEL没有那么多列
Name2Num = Range("A1:" & ColumnName & "1").Cells.Count
End Function
17.使用VBA给单元格设置公式 :( FormulaR1C1 )
・简单例子
' D5单元格为 "=B5+C5"
Range("D5").select
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
' RC 代表 行 和 列, 以选择单元格为【坐标原点】,
' 坐标原点是 D5, 4列
’ 所以取 B5, C5时,
’ 既是取 第二列, 相对于【坐标原点(4列 )】的位置:RC[-2]
’ 第三列 相对于【坐标原点(4列 )】的位置:RC[-1]
===
・具体例子
' one cell set formula
Range("B2").Select
Selection.NumberFormatLocal = "G/標準"
ActiveCell.FormulaR1C1 = XXXX ' 设置公式的时候,录制宏,从宏中取得公式即可
'set all columns cell formula
Range("B2").Select
Selection.AutoFill Destinaion:=Range("B2:Z2"), Type:xlFillDefault
'set all rows cell formula
Range("B2:Z2").Select
Selection.AutoFill Destinaion:=Range("B2:Z100"), Type:xlFillDefault
ActivateSheet.Calculate
===
获取单元格的公式,下面代码第三行
a = Range("B1").Value
b = Range("B1").Text
c = Range("B1").Formula
===
18.打开另外一个Excel,并操作其中的内容 (有坑)
正常代码(要定义在Module中)
public Function testFilter1()
Dim wb1 As Workbook
Set wb1 = Workbooks.Open("c:\AAA\BBB\test.xlsx", UpdateLinks:=0)
wb1.Activate
sheets("testSheet").Select
Range(“A5:AA5”).select ' ソースはModuleで定義しないと、ここでエラー発生する。 (坑)
Selection.AutoFilter ' 選択範囲のフィルターを除外する
wb1.Close savechanges:=False
End Function
’ ソースはModuleで定義しない、直接シートで定義なら、下記のように、ソース作成必要です。
(如果不在Module中定义,要像下面4,5行 这样,加上前缀) (不加报错,坑!!!)
Dim wb1 As Workbook
Set wb1 = Workbooks.Open("c:\AAA\BBB\test.xlsx", UpdateLinks:=0)
wb1.Activate
wb1.sheets("testSheet").Select
wb1.sheets("testSheet").Range(“A5:AA5”).select
Selection.AutoFilter
wb1.Close savechanges:=False
====
19.VBA 后台打开Excel (坑)
(坑:一些代码无法运行,不如 上面18中的 【Selection.AutoFilter】)
Dim cpApp As Excel.Application
Set cpApp = CreateObject("Excel.Application")
cpApp.Visible = False
Set wb1 = cpApp.Workbooks.Open("c:\AAA\BBB\test.xlsx")
20.Excel VBA 读取 XML (各种参照资料)
Dim xmlDom
Set xmlDom = CreateObject ("Microsoft.XMLDOM")
xmlDom.Load(folder_location + "\wkf_batch_logging_template.xml")
Set entry_fields = xmlDom.SelectNodes("beans/bean/entry")
For Each entry_field In entry_fields
。。。
・【xmlDom】创建
vba读取xml文件_jiudihanbing的博客-CSDN博客_vba读取xml文件
Set xmlDom = CreateObject ("Microsoft.XMLDOM")
・【xmlDom】各种方法属性
利用Excel的VBA来处理XML_indifferent_to的博客-CSDN博客_vba xml
xmlDom.Load(folder_location + "\wkf_batch_logging_template.xml")
・通过selectNodes,selectSingleNode获取 XML文件节点内容
VB读取XML文件,selectNodes获取节点属性_东语~的博客-CSDN博客_vb 读取xml
Set entry_fields = xmlDom.SelectNodes("beans/bean/entry")
For Each entry_field In entry_fields
===
21.Excel VBA 读取 XML (简单应用)
读取对象XML
C:\test\testVBA_XML\pom.xml
<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 https://maven.apache.org/xsd/maven-4.0.0.xsd">
<modelVersion>4.0.0</modelVersion>
<groupId>com.sxz</groupId>
<artifactId>test001</artifactId>
<version>0.0.1-SNAPSHOT</version>
<properties>
<project.build.sourceEncoding>UTF-8</project.build.sourceEncoding>
</properties>
<parent>
<groupId>org.springframework.boot</groupId>
<artifactId>spring-boot-starter-parent</artifactId>
<version>2.3.10.RELEASE</version>
</parent>
<dependencies>
<dependency>
<groupId>org.springframework.boot</groupId>
<artifactId>spring-boot-starter-web</artifactId>
</dependency>
<dependency>
<groupId>org.springframework.boot</groupId>
<artifactId>spring-boot-starter-batch</artifactId>
</dependency>
<dependency>
<groupId>org.springframework.boot</groupId>
<artifactId>spring-boot-starter-thymeleaf</artifactId>
</dependency>
<dependency>
<groupId>junit</groupId>
<artifactId>junit</artifactId>
<scope>test</scope>
</dependency>
<dependency>
<groupId>org.springframework.boot</groupId>
<artifactId>spring-boot-starter-test</artifactId>
<scope>test</scope>
</dependency>
<dependency>
<groupId>org.springframework.batch</groupId>
<artifactId>spring-batch-test</artifactId>
<scope>test</scope>
</dependency>
<dependency>
<groupId>com.github.springtestdbunit</groupId>
<artifactId>spring-test-dbunit</artifactId>
<version>1.3.0</version>
<scope>test</scope>
</dependency>
<dependency>
<groupId>org.dbunit</groupId>
<artifactId>dbunit</artifactId>
<version>2.6.0</version>
<scope>test</scope>
</dependency>
<dependency>
<groupId>commons-io</groupId>
<artifactId>commons-io</artifactId>
<version>2.8.0</version>
</dependency>
<!-- https://mvnrepository.com/artifact/javax.inject/javax.inject -->
<!-- https://repo1.maven.org/maven2/javax/inject/-->
<dependency>
<groupId>javax.inject</groupId>
<artifactId>javax.inject</artifactId>
<version>1</version>
</dependency>
</dependencies>
<repositories>
<repository>
<id>repo1</id>
<name>repo1</name>
<url>https://repo1.maven.org/maven2</url>
</repository>
</repositories>
<build>
<plugins>
<plugin>
<groupId>org.springframework.boot</groupId>
<artifactId>spring-boot-maven-plugin</artifactId>
<configuration>
<includeSystemScope>true</includeSystemScope>
</configuration>
</plugin>
</plugins>
</build>
</project>
读取XML用的VBA代码
(output:从Excel的 【C8】 单元格 开始)
Public Function readXML()
MsgBox "begin"
Dim xmlDom
Dim folder_location
Set xmlDom = CreateObject("Microsoft.XMLDOM")
folder_location = "C:\test\testVBA_XML"
xmlDom.Load (folder_location + "\pom.xml")
Set dependency_fields = xmlDom.SelectNodes("project/dependencies/dependency/artifactId")
Dim i
i = 0
For Each dependency_field In dependency_fields
'Range("C" & (8 + i)) = dependency_field.NodeValue
Range("C" & (8 + i)) = dependency_field.Text
i = i + 1
Next
MsgBox "end"
End Function
读取XML节点的结果
spring-boot-starter-web
spring-boot-starter-batch
spring-boot-starter-thymeleaf
junit
spring-boot-starter-test
spring-batch-test
spring-test-dbunit
dbunit
commons-io
javax.inject
===
23.动态二维数组定义
public var01() As String
public itemCount As Integer
Function initProcess()
itemCount = Sheets("Tool").Rang("B3").value
ReDim var01(itemCount, itemCount) As String
End Function
===
24.行列扩展操作(右拉,下拉)
' 选中要扩展的区域,A1到B4
Range("A1:B4").select
' 扩展20行 (向下扩展)
Selection.AutoFill Destination:Range("A1:B20"), Type:=xlFillDefault
===
25.数字列,字母列转化
'列数转字母
Function CNtoW(ByVal num As Long) As String
CNtoW = Replace(Cells(1, num).Address(False, False), "1", "")
End Function
'字母转列数
Function CWtoN(ByVal AB As String) As Long
CWtoN = Range("a1:" & AB & "1").Cells.Count
End Function
===
26.代码补全操作
出现提示后,按下【Tab】键,即可补全代码
===
27.全角 转换 成半角 (【StrConv】 函数)
halfConvert = StrConv(originalStr, vbNarrow)
定数 | 値 | 説明 |
---|---|---|
vbUpperCase | 1 | 文字列を大文字に変換します。 |
vbLowerCase | 2 | 文字列を小文字に変換します。 |
vbProperCase | 3 | 文字列のすべての単語の最初の文字を大文字に変換します。 |
vbWide | 4 | 文字列の半角 (1 バイト) 文字を全角 (2 バイト) 文字に変換します。 東アジア ロケールに適用されます。 |
vbNarrow | 8 | 文字列の全角 (2 バイト) 文字を半角 (1 バイト) 文字に変換します。 東アジア ロケールに適用されます。 |
vbKatakana | 16 | 文字列のひらがなをカタカナに変換します。 日本のみに適用されます。 |
vbHiragana | 32 | 文字列のカタカナをひらがなに変換します。 日本のみに適用されます。 |
vbUnicode | 64 | システムの既定のコード ページを使用して文字列を Unicode に変換します (Macintosh では使用できません)。 |
vbFromUnicode | 128 | 文字列を Unicode からシステムの既定のコード ページに変換します (Macintosh では使用できません)。 |
===
28.空行グループ化 ( 空行 group )
' 空行グループ化 ( B列,从30行开始,一直到400行, 最开始的空行~400行 group 化 )
For i = 30 To 400
cellValue = Cells(i, 2).Value
If cellValue = Empty then
Rows(i & ":400").Select
Selection.Rows.Group
Exit For
End if
Next i
' 折叠表示(グループ化表示) (最开始的空行~400行 group 化)
ActiveSheet.Outline.ShowLevels RowLevels:=1
' 展开表示
' ActiveSheet.Outline.ShowLevels RowLevels:=2
29.把字符串中的某一个字符,由小写转换为大写
比如,把setaXXX 转换为 setAXXX
代码如下
Private Sub CommandButton1_Click()
i = 3
Dim cellValue
cellValue = Cells(i, 2).Value
Do While cellValue <> Empty
cellValue = Cells(i, 2).Value
For j = 1 To 26
cellValue = Replace(cellValue, "set" & Chr(96 + j), "set" & Chr(96 + j - 32))
Next
Range("E" & i).Value = cellValue
i = i + 1
Loop
End Sub
a的ASCII码数值是97,A的ASCII码数值是65
===
30.XXX
31.XXX
===
■其他
1.快捷键操作
VBA 打开 Debug窗口 进行调试 (同时可以查看debug操作对应的快捷键)_sun0322的博客-CSDN博客_vba调试窗口
===
2.代码补全操作
出现提示后,按下【Tab】键,即可补全代码
==