VBA

Question

抱歉，我没有显示我的变量或任何东西，试图提供仅与问题相关的信息。这个 1 Sub 很大。

目前我的代码允许用户 select 多个文件，文件 selected 将以特定格式排序，然后加载到 2 个不同的数组中。当前将列 D:E 加载到 1 个数组中，将列 I:K 加载到另一个数组中（来自 selected 文件 QSResultFileWS，并且 returns 这些数组到我的目的地 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)-------------------------------

代码按原样运行良好，但是某些列中存在我不关心的空白行 returning。

例如： D 列 - 将始终具有字符串值 - 但整行不会始终具有 E、I、J、K 列的字符串值（来自 QSResultFileWS - E I J K 在 FormattingWS 上转换为 E F G H）

1 selected 文件中的“数据集”将有 112 行，我只需要 90 行，数据集中的其他 22 行将是空白的，但 D 列除外。一旦我申请我的排序，那22个空格总是在最前面（见图）

对于另一个视觉效果，这里是 1 个数据集停止（第 122 行）和另一个数据集开始的地方。

这是它在我的目标 WB 上的样子（我在此 WB 上导入数据的列是 D、E、F、G、H 列。M 和 N 列用我的其余代码填充我没有提供）。

最后我的问题是，如果 E I J K 列的行为空，有没有办法告诉数组不要 return D 列信息？或者，如果它使它更容易，仅当 E 列为空白时。如果 E 为空，则其余列也应为空。

我想在所有这些代码发生之前，我可以添加一个反向循环并删除所有这些行，如果这不那么麻烦我可以这样做，但在我永无止境地学习数组的尝试中我认为我会问。欢迎使用我目前的方法 feedback/explanations！

谢谢！

使用 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)-------------------------------

根据我对 Chris 的建议的简要理解，这就是我想出的，而且似乎有效！

自从我添加

                       If r.Offset(0, 1).Value = vbNullString Then
                            r.Value = vbNullString
                        End If

我想我可以将过滤代码改回 Chris 最初建议的那样，它应该可以正常工作，但我真的不想碰任何东西，哈哈。

Answer 1

您可以使用 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 returns Nothing
还有一些其他问题

range.Find 需要指定一些参数。请参阅 link 开头的注释 每次使用此方法时都会保存 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))
                          ^^^   ^^^           ^^^

VBA - 加载数组，跳过空白

VBA - Loading Arrays, Skipping Blanks

arrays

excel

office365