arrays - VBA - 加载数组，跳过空白
问题描述
对不起，我没有显示我的变量或任何东西，试图只提供与问题有关的信息。这个 1 Sub 很大。
目前我的代码允许用户选择多个文件，选择的文件将以特定格式排序，然后加载到 2 个不同的数组中。目前将 D:E 列加载到 1 个数组中，将 I:K 列加载到另一个数组中（从选定的文件QSResultFileWS中，并将这些数组返回到我的目的地FormattingWS。我仍在尝试学习数组，所以如果我用来执行此操作的方法不是对了，温柔点。
FileToOpen = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select all files needing analyzed", MultiSelect:=True) 'if file types change to csv or something else, this needs changed
If Not IsArray(FileToOpen) Then Exit Sub
With FormattingWS
.Range("D10").Value = "Sample Name"
.Range("E10").Value = "Target Name"
.Range("F10").Value = "Crt"
.Range("H10").Value = "Crt SD"
.Range("G10").Value = "Crt Average"
.Range("M10").Value = "Final Result"
.Range("N10").Value = "Final Crt"
End With
'select all result files at once
For Each ResultFile In FileToOpen '---------------------------------Import Result Files (Start)----------------------------
Set QSResultFileWB = Workbooks.Open(ResultFile)
Set QSResultFileWS = QSResultFileWB.Sheets("Results")
TotalRows = 0
Counter = 0
With QSResultFileWS
Set SampleName = .Range("A1:Q50").Find("Sample Name") 'find column that I want to count all the rows - This column will always have data regardless of any blanks in other columns
SampleNameLastRow = .Cells(.Rows.Count, SampleName.Column).End(xlUp).Row
Set SampleNameStart = .Range("D" & SampleName.Row).Offset(1, 0) 'offset 1 row to avoid grabbing the headers
QSResultFileWSLastUsedColumn = .Cells(20, Columns.Count).End(xlToLeft).Column 'row 20 is where headers start '------------------------------Sort Data to get Targets Grouped Together(Start)-----------------------------
.Sort.SortFields.Clear
.Sort.SortFields.Add2 Key:=Range("D21:D" & SampleNameLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
.Sort.SortFields.Add2 Key:=Range("E21:E" & SampleNameLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers 'blanks will be present in this column
With QSResultFileWS.Sort
.SetRange Range(Cells(20, 1), Cells(SampleNameLastRow, QSResultFileWSLastUsedColumn))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With '------------------------------Sort Data to get Targets Grouped Together(End)-----------------------------
With QSResultFileWS.Range("D" & SampleNameStart.Row, "D" & SampleNameLastRow)
For Each r In .Rows
If Application.CountA(r) <> 0 Then
Counter = Counter + 1
End If
Next r
TotalRows = Counter
End With
sampleArrayDE = .Range("D21:E" & SampleNameLastRow).Value 'Load Columns D:E into Array from Source WB - if row has blanks, Column E will also have blanks, Column D will not have blanks
sampleArrayIK = .Range("I21:K" & SampleNameLastRow).Value 'Load Columns I:K into Array from Source WB - if row has blanks, Columns I:K will all contain blanks
End With
With FormattingWS
DlastRow = FormattingWS.Cells(Rows.Count, "D").End(xlUp).Row
Set DEColumnRng = FormattingWS.Range("D" & DlastRow).Offset(1, 0)
Set IKColumnRng = FormattingWS.Range("F" & DlastRow).Offset(1, 0)
FormattingWS.Range(DEColumnRng, "E" & (DEColumnRng.Row + TotalRows) - 1).Value = sampleArrayDE 'Return D:E Array to Destination WB - DEColumnRng gives where the next data set should start populating - if File 1 then data starts populating in 11, then ((add TotalRows) - 1) to return everything initially loaded to array
FormattingWS.Range(IKColumnRng, "H" & (DEColumnRng.Row + TotalRows) - 1).Value = sampleArrayIK 'Return I:K Array to Destination WB
End With
Erase sampleArrayDE
Erase sampleArrayIK
QSResultFileWS.Parent.Close False
Next ResultFile '---------------------------------Import Result Files (End)-------------------------------
代码可以正常工作，但是某些列中有我不关心返回的空白行。
例如： D 列 - 总是有一个字符串值 - 但整行并不总是有 E、I、J、K 列的字符串值（从QSResultFileWS- EIJK 转换为 EFGH on FormattingWS）
所选文件中的 1 个“数据集”将有 112 行，我只需要 90 行，数据集中的其他 22 行将是空白，但 D 列除外。一旦我应用我的排序，那 22 个空白总是在顶部（见图）
对于另一种视觉效果，这里是 1 个数据集停止（第 122 行）和另一个数据集开始的地方。
这是它在我的目标 WB 上的外观（我在此 WB 上导入数据的列是 D、E、F、G、H 列。M 和 N 列填充了我没有提供的其余代码） .
最后我的问题是，如果列 EIJK 的行为空白，有没有办法告诉数组不返回 D 列信息？或者，如果它使它更容易，只有当 E 列是空白时。如果 E 为空白，则其余列也应为空白。
我想在所有这些代码发生之前，我可以添加一个反向循环并删除所有这些行，如果这不那么麻烦，我可以这样做，但是在我永无止境的学习数组的尝试中，我想我会问。欢迎对我当前方法的任何反馈/解释！
谢谢！
编辑 W/ Chris 的解决方案
FileToOpen = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select all files needing analyzed", MultiSelect:=True) 'if file types change to csv or something else, this needs changed
If Not IsArray(FileToOpen) Then Exit Sub
With FormattingWS
.Range("D10").Value = "Sample Name"
.Range("E10").Value = "Target Name"
.Range("F10").Value = "Crt"
.Range("H10").Value = "Crt SD"
.Range("G10").Value = "Crt Average"
.Range("M10").Value = "Final Result"
.Range("N10").Value = "Final Crt"
End With
'select all result files at once
For Each ResultFile In FileToOpen '---------------------------------Import Result Files (Start)----------------------------
Set QSResultFileWB = Workbooks.Open(ResultFile)
Set QSResultFileWS = QSResultFileWB.Sheets("Results")
TotalRows = 0
Counter = 0
With QSResultFileWS
Set SampleName = .Range("A1:Q50").Find("Sample Name")
SampleNameLastRow = .Cells(.Rows.Count, SampleName.Column).End(xlUp).Row
Set SampleNameStart = .Range("D" & SampleName.Row).Offset(1, 0)
QSResultFileWSLastUsedColumn = .Cells(20, Columns.Count).End(xlToLeft).Column '------------------------------Sort Data to get Targets Grouped Together(Start)-----------------------------
.Sort.SortFields.Clear
.Sort.SortFields.Add2 Key:=Range("D21:D" & SampleNameLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
.Sort.SortFields.Add2 Key:=Range("E21:E" & SampleNameLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlsortextasnumbers
With QSResultFileWS.Sort
.SetRange Range(Cells(20, 1), Cells(SampleNameLastRow, QSResultFileWSLastUsedColumn))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With '------------------------------Sort Data to get Targets Grouped Together(End)-----------------------------
With QSResultFileWS.Range("D" & SampleNameStart.Row, "D" & SampleNameLastRow)
Dim r As Range
For Each r In .Rows
If r.Offset(0, 1).Value = vbNullString Then
r.Value = vbNullString
End If
If Application.CountA(r) <> 0 Then
Counter = Counter + 1
End If
Next r
TotalRows = Counter
End With
Set rng = .Range("D21:E" & SampleNameLastRow)
Set rng2 = .Range("I21:K" & SampleNameLastRow)
sampleArrayDE = rng.Worksheet.Evaluate("FILTER(" & rng.Address & "," & rng.Columns(2).Address & "<>"""")")
sampleArrayIK = rng2.Worksheet.Evaluate("FILTER(" & rng2.Address & "," & rng2.Columns(1).Address & "<>"""")")
End With
With FormattingWS
DlastRow = FormattingWS.Cells(Rows.Count, "D").End(xlUp).Row
Set DEColumnRng = FormattingWS.Range("D" & DlastRow).Offset(1, 0)
Set IKColumnRng = FormattingWS.Range("F" & DlastRow).Offset(1, 0)
FormattingWS.Range(DEColumnRng, "E" & (DEColumnRng.Row + TotalRows) - 1).Value = sampleArrayDE
FormattingWS.Range(IKColumnRng, "H" & (DEColumnRng.Row + TotalRows) - 1).Value = sampleArrayIK
End With
Erase sampleArrayDE
Erase sampleArrayIK
QSResultFileWS.Parent.Close False
Next ResultFile '---------------------------------Import Result Files (End)-------------------------------
根据我对克里斯建议的简要了解，这就是我想出的，它似乎正在奏效！
自从我添加
If r.Offset(0, 1).Value = vbNullString Then
r.Value = vbNullString
End If
我想我可以将过滤代码改回 Chris 最初建议的内容，它应该可以正常工作，但我真的不想碰任何东西，哈哈。
解决方案
您可以使用该FILTER功能删除空白。
替换你的行加载数组
sampleArrayDE = .Range("D21:E" & SampleNameLastRow).Value
有了这个
Set rng = .Range("D21:E" & SampleNameLastRow)
sampleArrayDE = rng.Worksheet.Evaluate("FILTER(" & rng.Address & "," & rng.Columns(1).Address & "<>"""")")
笔记：
- 需要支持动态数组的 Excel 版本
Dim rng As range与您的其他变量一起添加- 您可能需要考虑
Find退货的情况Nothing - 还有其他几个问题
range.Find需要指定一些参数。请参阅链接中的注释开始每次使用此方法时都会保存 LookIn、LookAt、SearchOrder 和 MatchByte 的设置。- 您有一些不合格的范围参考。添加对这些的工作表引用
.Sort.SortFields.Add2 Key:=Range("D21:D" & SampleNameLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
^^^
.Sort.SortFields.Add2 Key:=Range("E21:E" & SampleNameLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
^^^
With QSResultFileWS.Sort
.SetRange Range(Cells(20, 1), Cells(SampleNameLastRow, QSResultFileWSLastUsedColumn))
^^^ ^^^ ^^^
推荐阅读
- cakephp - 更新后测试：找不到插件类`WyriHaximus\TwigView\Plugin`
- java - 什么是字符串值中的编码器？
- php - Laravel 419 错误 - 使用 Ajax 时出现 VerifyCsrfToken 问题
- python - 将列表中的相同元素写入txt文件
- google-cloud-platform - 部署云功能时出错 ERROR: (gcloud.functions.deploy) ResponseError: status=[403], code=[Forbidden]
- javascript - 动态、ajax 驱动的内容的 200 状态
- node.js - Google App Engine 标准上的 Nodejs 版本
- javascript - 检查选择了哪个选项
- c# - 使用 Roslyn 检查基类是否实现了某个接口
- java - 如何重写我的代码以使 0 的值不会在 java 中给我一个越界错误？