1.1 如何用VBA从EXCEL表取数据？
-
有时候只是要把EXCEL表的数据读到VBA里
-
经常，我们需要读入EXCEL的数据，且能明确的知道每列的意义，并且根据某一列（比如 id列/ index列 ）来像EXCEL一样查找其他数据
-
其他对EXCEL数据的应用
1.2 问题升级
-
如果不是excel呢
-
如果是从xml文件读入的呢？ 识别, ？
-
如果是从json文件读入呢？ 识别key:value?
-
之后试试
2 如果只是要把EXCEL表的数据读到VBA里
2.1 取出Excel数据最直接的方法， array=range()
2.1.1 这种方法也叫 数组的整体赋值 / 一次性写入数组内容
-
就是变量和数组array=range()
-
一般认为range("") 会只能写死一个固定的区域，其实不然
-
实际上 range("") 很灵活可以带参数
-
range("") 内部""完全可以字符串拼接，可以按想法随意拼接，比如这样写 arr1 = sh1.Range("c" & 4 & ":h" & maxcount1 + 3)
-
range(cells(),cells())更灵活，比如这样写 arr1 = sh1.Range(sh1.Cells(4, c1), sh1.Cells(maxcount1 + 3, 8))
-
但是要注意写成 sh1.range( sh1.cells(), sh1.cells()) ,而不是sh1.range( cells(), cells())
Dim arr1
arr1 = sh1.Range("c" & 4 & ":h" & maxcount1 + 3)
arr1 = sh1.Range(sh1.Cells(4, c1), sh1.Cells(maxcount1 + 3, 8))
2.1.2 一次性写入数组，需要注意的问题
-
可以定义为变量arr1，然后变量 arr1=sh1.range()
-
可以定义为动态数组，dim arr1() 且 redim arr1()
-
arr1()=range("")
-
arr1()=range(cells(),cells())
-
都可以
-
但是不能定义为静态数组 dim arr1(1 to 5) ，静态数组不能一次性写入内容。
''' '遇到一个奇怪的问题，有一次居然遇到Range("b2:g17")可以，但是 sh1.Range("b2:g17")报错 类型不匹配？
'array(）函数的index默认从0开始 ，除非有 option base 1等 array(）是默认从0开始
'ReDim Preserve arr1(maxcount1, 6) 这样index也会从0开始，最好写成 ReDim Preserve arr1(1 to maxcount1, 1 to 6)
'但是,无论有没有特殊声明，array()=range() 默认行，列都是从1开始
'而且如果用option base 1 或 dim ( 1 to 10) 都是从1开始
''''--------------下面是把数值一次性装入数组！-------------------
'方法1，定义为变量，一次性装入赋值，（变量指向 range 就会自动变成 动态数组）
Dim sh1
Set sh1 = ThisWorkbook.Worksheets("模拟")
arr1 = sh1.Range("b2:g17")
''' '遇到一个奇怪的问题，有一次居然遇到Range("b2:g17")可以，但是 sh1.Range("b2:g17")报错 类型不匹配？
'方法2，类似方法1 定义为变量，且用range(cells(),cells())
''' Dim arr1
''' Set sh1 = ThisWorkbook.Worksheets("模拟")
''' arr1 = sh1.Range(sh1.Cells(2, 2), sh1.Cells(17, 7))
'方法3，定义为动态数组，可以一次性装入赋值/或者逐个写入都可以
''' Dim arr1()
''' ReDim arr1(1 To 16, 1 To 6) '其中16，6等都可以是参数, 也可以是数字常数
''' arr1() = sh1.Range("b2:g17")
'错误方法01，定义为静态数组，是不行的，静态数组无法一次性装入数据，只能循环一个个写入。
''' Dim arr1(1 To 16, 1 To 6) '静态数组的定义，必须一次性dim（不能带参数），且不能redim
''' arr1() = sh1.Range("b2:g17") '静态数组不允许一次性装入
'显示函数
For i = LBound(arr1, 1) To UBound(arr1, 1)
For j = LBound(arr1, 2) To UBound(arr1, 2)
Debug.Print "arr1(" & i & "," & j & ")=" & arr1(i, j),
Debug.Print
End Sub
2.1.3 VBA里一定要小心数组的起始 index() 是从0，还是从1开始
-
'array(）函数的index默认从0开始 ，除非有 option base 1等 array(）是默认从0开始
-
'ReDim Preserve arr1(maxcount1, 6) 这样index也会从0开始，最好写成 ReDim Preserve arr1(1 to maxcount1, 1 to 6)
-
'但是,无论有没有特殊声明，array()=range() 默认行，列都是从1开始 （EXCEL标都是从第1行，第1列开始的，EXCEL里没有0行0列这种标识方法，虽然VBA有）
-
'而且如果用option base 1 或 dim ( 1 to 10) 都是从1开始
2.1.4 一个奇怪的问题，备忘
-
'遇到一个奇怪的问题，有一次居然遇到Range("b2:g17")可以，但是 sh1.Range("b2:g17")报错 类型不匹配？
2.2 遍历一个区域的内容 -- 写入数组的写法
2.2.1 遍历写入数组， redim 时要特别注意多层循环，比如2维数组的内外层循环，行列谁在内层谁在外层的问题！
见下面的代码
-
这个要注意
-
其实一般EXCEL数据里，列数相对稳定（因为是 列名/字段名）
-
一般行数会变化很多，经常增加什么的，所以行数一般需要是参数，比如下面的maxcount1, 需要根据实际数据变化maxcount1 = sh1.Cells(999, c1).End(xlUp).Row - 3
-
redim arr() 数组只能改变最后一维，不能2个维度都变化
-
redim preserve arr()
-
redim arr() 数组，要求先定义为数组， dim arr1() 不能是 dim arr1 定义为变量
-
而且遍历时需要redim preserve arr() ，不加perserve 很可能只保留最后1个数组数据，
'读入数据
Dim sh1 As Object
Set sh1 = ThisWorkbook.Worksheets("data")
c1 = WorksheetFunction.Match("rank", sh1.Range("3:3"), 0)
c2 = WorksheetFunction.Match("ID", sh1.Range("3:3"), 0)
c3 = WorksheetFunction.Match("name", sh1.Range("3:3"), 0)
c4 = WorksheetFunction.Match("权重", sh1.Range("3:3"), 0)
c5 = WorksheetFunction.Match("name", sh1.Range("3:3"), 0)
maxcount1 = sh1.Cells(999, c1).End(xlUp).Row - 3
'根据需要去查全部的其他列数据
'其实这个可以直接用 等同于 arr1=range("a1:h8")
Dim arr1()
For j = 1 To 8
For i = 1 To maxcount1
ReDim Preserve arr1(16, j)
arr1(i, j) = Application.Index(sh1.Columns(c1 + j - 1), Application.Match(i, sh1.Columns(c1), 0))
2.2.2 双层循环的注意点！
- 动态数组在循环外redim一次
- 或 动态数组只在外层循环 redim，而在内层循环不redim
- 比如外层循环是列数，同时列数是最后1维，且redim 列数在变化（行数不能从小到大变化）
- 或 动态数组在 内层循环，不断的 redim，但是需要知道，之后最后一维才可以redim，如果第一维也在redim 就会报错，实际上这种方法是等同于 动态数组只在外层循环 redim的
2.2.3 循环写入数组时可能遇到得错误和对应问题！
- 语法错误
- 如果 redim(i,j) 如果i 也在变化，就可能会报错 数组下标越界（实际是index越界，第一维度不让redim导致）
- 逻辑错误
- 如果不写 redim preserve ，直接 redim 循环写入时，前面得数据会丢失，只有最后得数据
- 如果二维数组，双层循环配合 redim preserve写得不对，会导致只剩下第1列和最后1行数据,如果 内外层循环弄得不对，虽然没有语法错误，但是会造成逻辑错误，就是虽然 redim preserve了，但是因为 列数从大变小时，会裁剪数组，即使preserve也会丢失之前得数据
- 如果 redim preserve 还要写对 对应循环得层数，一般来说只在外层循环中。
- redim preserve arr1(i,j) 这样会造成多出0 行 0列数据来，因为这个例子之前arr1=range()里是从 1行1列开始得，所以要写成 redim preserve arr1( 1 to 16,1 to j) 才行！
Sub test12()
''''--------------下面是用循环，逐个往数组里装入数值！-------------------
''' '上面都是 数组一次性装入数值，下面是逐个装入数据的写法
Dim arr1()
Set sh1 = ThisWorkbook.Worksheets("模拟")
c1 = Application.Match("牌数", sh1.Rows("1:1"), 0)
maxcount1 = sh1.Cells(999, c1).End(xlUp).Row - 1
''' '方法4， 动态数组在循环外redim一次
''' 'ReDim Preserve arr1(maxcount1, 6) '这行注释掉了是错的，这样会多出1行和1列，数组index默认从0开始
''' ReDim Preserve arr1(1 To maxcount1, 1 To 6) '其实这里只redim了一次，循环开始前已经界定了动态数组实际范围--
''' For i = 1 To maxcount1
''' For j = 1 To 6
''' arr1(i, j) = Application.Index(sh1.Columns(c1 + j - 1), Application.Match(i, sh1.Columns(c1), 0))
''' Next
''' Next
'方法5，动态数组，每次循环都在redim 数组大小（其实写的不太好，方法6更好）
'redim 每次循环列都在变化（其实是外层循环时，数组最后一维才变化），同时内循环是行（内部循环时其实列数没变）
'''' For j = 1 To 6
'''' For i = 1 To maxcount1
'''' ReDim Preserve arr1(1 To maxcount1, 1 To j) 'arr1逐个数组从1列逐渐每次 + 新增1列 + 同时往新列里加数据
'''' arr1(i, j) = Application.Index(sh1.Columns(c1 + j - 1), Application.Match(i, sh1.Columns(c1), 0))
'''' Next
'''' Next
'方法6， redim动态数组，写在外层循环内，更合适
For j = 1 To 6
ReDim Preserve arr1(1 To maxcount1, 1 To j) 'redim 放在外层循环更合适
For i = 1 To maxcount1
arr1(i, j) = Application.Index(sh1.Columns(c1 + j - 1), Application.Match(i, sh1.Columns(c1), 0))
'''' '错误方法02,遍历时需要考虑 redim 扩展的方向--先填充(内循环的先填充)另外一个维度的内容-------内外2层嵌套次序要写对才行
'''' '因为只有最后1维可变化，也就是第1维，arr1数组行数始终是 maxcount1=16
'''' '这样得出的结果是，第1列和最后一行有数据，其他都空的，为啥呢
'''' '因为 第二维列j一直从1变6，又从6变1，从6变1的时候即使有redim也因为列数变小而丢失了数据
'''' '所以前面的行都只有第1列有数保留，j=2-5都被删掉了,而最后1行是因为j=6循环结束了不再缩小为1了
'''' For i = 1 To maxcount1
'''' For j = 1 To 6
'''' ReDim Preserve arr1(1 To maxcount1, 1 To j) '只有最后1维允许动态调整，前面那一维不能
'''' arr1(i, j) = Application.Index(sh1.Columns(c1 + j - 1), Application.Match(i, sh1.Columns(c1), 0))
'''' Next
'''' Next
'''' '错误方法03，i修改为16/ maxcount1就对了,因为VBA里动态数组redim只允许最后1列改变
'''' For j = 1 To 6
'''' For i = 1 To maxcount1
'''' ReDim Preserve arr1(1 To 16, 1 To j) '会报错下标index越界，
'''' arr1(i, j) = Application.Index(sh1.Columns(c1 + j - 1), Application.Match(i, sh1.Columns(c1), 0))
'''' Next
'''' Next
'显示函数
For i = LBound(arr1, 1) To UBound(arr1, 1)
For j = LBound(arr1, 2) To UBound(arr1, 2)
Debug.Print "arr1(" & i & "," & j & ")=" & arr1(i, j),
Debug.Print
End Sub
3.2 首先用 match() 等很方便的去查找要找信息的 行/列 号信息
- 用 match() ，根据 列名（比如rank） 去取得关键的行/列 号信息
- 然后怎么利用这些 行/列 号信息 去查到具体的数据
3.2.1 总体来说，用 r1c1模式去 定位数据 更方便
- 可用的函数
- indirect(r1c1,false)
- index( range, row,column)
- 其他函数
3.2.2 indirect() +match()
- indirect("r1c1",false)
- indirect("r"& 1 & "c" & 2,false) 其中& 用concatenate() 是可以的
- indirect("r"& match() & "c" & match() ,false)
3.2.3 用 index() +match()
- index( range ,row ,column) 可以定位到数据
- index( range ,match() ,match())
3.3 定位的技巧问题
3.3.1 用 row+ column 定位到一个单元格
- 如果用range()
- range("") 直接用的是 A1模式，但是可以拼接字符串
- range("") 内部""完全可以字符串拼接，可以按想法随意拼接，比如这样写 arr1 = sh1.Range("c" & 4 & ":h" & maxcount1 + 3)
- 想用range() 且用r1c1模式，就需要用到range(cells(),cells())
- range(cells(),cells())更灵活，比如这样写 arr1 = sh1.Range(sh1.Cells(4, c1), sh1.Cells(maxcount1 + 3, 8))
3.3.2 如果想表示 1行1列
- 用range() 还是 A1模式，且用不了range(cells(),cells())
- 只能是
- range("3:3")
- range("A:A")
更好的方法是用 rows() columns() 表示1行，1列更简洁
rows(3) 和 columns(3) 天生的就是 r1c1的引用格式，很简洁
- rows(3)
- columns(3)
- 比如下面
- m1 = Application.Index(sh1.Columns(c2), Application.Match(5, sh1.Columns(c1), 0))
3.3.3 如果想表示 1个区域
- range("") 是很直接的
- 用数组，尤其是 二维数组，array() 存储 EXCEL的数据是非常合适的
- 下面也有例子
'读入数据
Dim sh1 As Object
Set sh1 = ThisWorkbook.Worksheets("data")
c1 = WorksheetFunction.Match("rank", sh1.Range("3:3"), 0)
c2 = WorksheetFunction.Match("ID", sh1.Range("3:3"), 0)
c3 = WorksheetFunction.Match("name", sh1.Range("3:3"), 0)
c4 = WorksheetFunction.Match("权重", sh1.Range("3:3"), 0)
c5 = WorksheetFunction.Match("name", sh1.Range("3:3"), 0)
maxcount1 = sh1.Cells(999, c1).End(xlUp).Row - 3
'测试，用rank=5这个信息去查找对应的id是多少
m1 = Application.Index(sh1.Columns(c2), Application.Match(5, sh1.Columns(c1), 0))
'根据需要去查全部的其他列数据
'其实这个可以直接用 等同于 arr1=range("a1:h8")
Dim arr1()
For j = 1 To 8
For i = 1 To maxcount1
ReDim Preserve arr1(16, j)
arr1(i, j) = Application.Index(sh1.Columns(c1 + j - 1), Application.Match(i, sh1.Columns(c1), 0))
3.3.4 使用match() 等函数时，尽量带参数，不要带写死的列名等
- 比较下面2句写法
- Application.Match(ra1, sh1.Columns(c1), 0))
- Application.Match(i, sh1.Range("c:c"), 0)
'更好的写法，带着参数
c1 = WorksheetFunction.Match("rank", sh1.Range("3:3"), 0)
sh2.Cells(bb, 3) = Application.Index(sh1.Columns(c2), Application.Match(ra1, sh1.Columns(c1), 0))
' 这种写法不好，因为写死了列名，之后不好修改
arr1(i) = WorksheetFunction.Match(i, sh1.Range("c:c"), 0)
Word VBA中读取Excel表格中的数据
前天有一个项目需要写详细设计报告，其中有一块重要内容是把Excel中的每一行数据做成一个Word中的表格。一共将近100行数据，如果我一行一行地手动去做，估计手就废了，于是采用Word VBA。
基本编程思路
创建一个空word文档
word文档中，编辑好一个示例表格，作为一个母表，后续所有的表格程序都是复制这张表，然后修改复制后的新表格的数据
打开Excel，遍历每一行数据
取这一行关键数据，复制母表，改变复制后的表格数据
Dim wb As D
Dim wkbk As Workbook '定义一个工作薄
Dim myFileName As String '定义要读取的文件路径
Dim dataRow As Integer '定义数据的行
Dim dataColumn As Integer '定义数据的列
Dim rgRC As String '读
For Each Rng In Sheets("目录").Range("b1:B23")
Debug.Print Rng.Value
If Rng.Value = "个人" Then
n = n + 1
Sheets("备注").Cells(n, "g").Resize(1, 5) = Rng.Offset(0, -1).Range("a1:e1").Value
Sheets("备注").Cells(n, "g").
ChitGPT：你好！关于你的问题，你可以使用VBA打开txt文件，使用Split函数将数据按行进行拆分，然后将拆分后的数据存储到数组中。接下来，你可以在Excel中打开一个新的工作表，将数组中的数据按照列进行拆分输出。
以下是一个简单的VBA代码示例：
Sub ReadTxtFile()
Dim filePath As String
Dim dataArray() As String
Dim dataRange As Range
Dim i As Integer, j As Integer
'选择要打开的文本文件'
filePath = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), *.txt")
If filePath = "False" Then Exit Sub
'打开文件，读取数据到数组中'
Open filePath For Input As #1
dataArray = Split(Input$(LOF(1), 1), vbNewLine)
Close #1
'在Excel中输出数据到新工作表上'
Sheets.Add
Set dataRange = Range("A1").Resize(UBound(dataArray) + 1, 1)
dataRange = Application.Transpose(dataArray)
For j = 1 To UBound(dataArray) + 1
For i = 1 To UBound(Split(dataArray(j - 1)))
Cells(i, j) = Split(dataArray(j - 1))(i - 1)
Next i
Next j
End Sub
希望能够帮到你！
2201_75674929:
