VBA中各种数据类型的使用（自定义数据类型Type，数组，数据字典）、读写文件...


'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'*
'*  自定义学生对象
'*  做成时间: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./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./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

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 )

・简单例子

' C1单元格为"=$A$2+$E$3"
Range("C1").FormulaR1C1 = "=R2C1+R3C5"
' R2C1表示的是【第2行,第1列】的单元格即A2单元格

===

・具体例子

' 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.XXX

xxx

本站是提供个人知识管理的网络存储空间，所有内容均由用户发布，不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息，谨防诈骗。如发现有害或侵权内容，请点击一键举报。

转藏分享

QQ空间 QQ好友新浪微博微信

献花（0） +1

来自： F2967527 > 《VBA》

举报/认领

0条评论

发表

请遵守用户评论公约

类似文章 更多

F2967527

关注对话

TA的最新馆藏

专治脱发，头发油，我的方法不保密，能帮一个是一个
说说虚劳
膝盖一直磨损？「养血荣筋丸」既能扶正又能祛邪，铲除陈旧性关节损伤！
有个天然“补脑丸”，特别适合气不足的大虚人
一个中成药，修复胃黏膜，治疗老胃病
这个中成药延缓衰老，堪称男人的加油站，女人的美容院

喜欢该文的人也喜欢更多

热门阅读换一换

VBA中 各种数据类型的使用（自定义数据类型Type，数组，数据字典）、读写文件...

1.各种数据类型

2.VBA定义公共数组（全局都可以使用）

3.读写文件

SJIS 写入

UTF8 写入

读取 SJIS

读取 UTF-8

4.异常处理

5.忽略错误

6.其他常用1

7.其他常用2：读取（多个）Excel文件

8. ★★★ 各种常用操作总结 ★★★

9.事件相关处理 （保存，离开单元格等操作时，触发处理）

10.定义（调用）有返回值的函数

11.使用VBA操作IE浏览器

12.Variant 变量类型

13.调用bat （使用cmd，直接运行程序）

14.调用Jar,并获取返回值

核心代码

具体内容

15.循环(For、While)

For

While

16.Excel-VBA：列号与字母（列名）的相互转换

17.使用VBA给单元格设置公式 :（ FormulaR1C1 )

18.XXX

VBA中各种数据类型的使用（自定义数据类型Type，数组，数据字典）、读写文件...

8. ★★★ 各种常用操作总结　★★★

9.事件相关处理（保存，离开单元格等操作时，触发处理）