VBA复制带有空白的数据，但自动粘贴"N/A"空白点

Question

我想用空格复制数据，但会自动用字符串"N/A"；粘贴后不使用"替换"。我从中复制的数据文件相当大，并且希望避免只在所有空白的单元格中填充"；N/A"；

我不想使用的示例。

Range("A:A").Replace What:="", Replacement:="N/A"

问题：

我遇到的问题是，我在许多数据文件中迭代，根据用户表单列表框中的选择来寻找某些数据点，并将特定的数据点粘贴到新的结果文件中。但是，如果有空白，数据就会不匹配，因为我只是将复制的数据粘贴到某一列中的下一个空单元格中。因此，我最终遇到了数据不对齐的情况，并希望输入"；不适用于有空格的地方。

问题的例子以及我想要实现的目标：

在此处输入图像描述

复制粘贴循环：

For n = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(n) = True Then
Windows(DataFileName).Activate
Set FoundString = Sheets(1).Rows("1").Find(What:=ListBox2.List(n), LookIn:=xlValues, LookAt:=xlWhole)        'Search For File Attributes
ColumnLetter = Split(Cells(1, FoundString.Column).Address, "$")(1)        'Convert Column Number to Letter
Range(ColumnLetter & "2:" & ColumnLetter & LastRow).Copy
Windows(ResultsFileName).Activate        'Open Results File
Set FoundString = Sheets("Results").Rows("1").Find(What:=ListBox2.List(n), LookIn:=xlValues, LookAt:=xlWhole)        ' Search For File Attributes within Result File
ColumnLetter = Split(Cells(1, FoundString.Column).Address, "$")(1)        'Convert Column Number to Letter
Range(ColumnLetter & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If

Answer 1

一旦要复制的数据有了Range，就可以将值放入数组中，将所有Empty值更改为"N/A"，然后将其粘贴到目标Range中。

Sub Example()
Dim CopyRange As Range
Set CopyRange = ThisWorkbook.Worksheets(1).Range("A1:A8")

Dim DestinationRange As Range
Set DestinationRange = ThisWorkbook.Worksheets(1).Range("B1:B8")

'Take the values from the CopyRange into an array
Dim Values() As Variant
Values = CopyRange.Value

'Loop through the 2D array
Dim i As Long, j As Long
For i = LBound(Values, 1) To UBound(Values, 1)
For j = LBound(Values, 2) To UBound(Values, 2)
'Change blank values into "N/A"
If IsEmpty(Values(i, j)) Then Values(i, j) = "N/A"
Next
Next

'Paste the values into the destination range
DestinationRange.Value = Values
End Sub

下面是一个使用上面代码片段的示例。

Sub Example2()
Dim n As Long
For n = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(n) = True Then
Dim ListBox2Val As Variant
ListBox2Val = ListBox2.List(n)

Dim DF As Workbook
Set DF = Windows(DataFileName).Parent

Dim DS As Worksheet
Set DS = DF.Worksheets(1)

Dim DataValues() As Variant
Set FoundString = DS.Rows("1").Find(What:=ListBox2Val, LookIn:=xlValues, LookAt:=xlWhole)        'Search For File Attributes
DataValues = FoundString.EntireColumn.Cells(2, 1).Resize(LastRow - 1).Value

'Loop through the 2D array
Dim i As Long, j As Long
For i = LBound(DataValues, 1) To UBound(DataValues, 1)
For j = LBound(DataValues, 2) To UBound(DataValues, 2)
'Change blank values into "N/A"
If IsEmpty(DataValues(i, j)) Then DataValues(i, j) = "N/A"
Next
Next

Dim RF As Workbook
Set RF = Windows(ResultsFileName).Parent

Dim RS As Worksheet
Set RS = RF.Worksheets("Results")

Set FoundString = RS.Rows("1").Find(What:=ListBox2Val, LookIn:=xlValues, LookAt:=xlWhole)        ' Search For File Attributes within Result File
FoundString.EntireColumn.Cells(RS.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(DataValues, 1)).Value = DataValues
End If
Next
End Sub

这个例子是基于你发布的代码片段，并不是一个完整的例子。我缺少ListBox2、LastRow、DataFileName、ResultsFileName、FoundString、n的定义