作者：绿色风
分类：
时间：2022-08-18
浏览：106
楼主
LOGO |
要求如下图所示：
 QQ截图20131209125552.jpg
结果如下图所示，经过用公式进行比较，结果和要求的数据一致。
 QQ截图20131209133434.jpg
VBA代码如下：- Sub 注入一()
- Dim 空值 As Range, 备选 As Range, 个数 As Integer, brr(), i As Integer
- Set 空值 = Range("F3:I11")
- Set 备选 = Range("B3:D11")
- Application.ScreenUpdating = False
- Application.Calculation = xlCalculationManual
- For 个数 = 1 To 空值.Count
- If 空值(个数) = "" Then
- i = i + 1
- ReDim Preserve brr(1 To i)
- brr(i) = 空值(个数).Address
- End If
- Next
- For i = 1 To UBound(brr)
- Range(brr(i)).Value = 备选.Cells(i)
- Next
- Application.ScreenUpdating = True
- Application.Calculation = xlCalculationAutomatic
- End Sub
VBA中cells的引用方式：从左到右，从上到下
另如果数据量较大，还可以借助数组进行提速。
思路：1.通过循环记录空白单元格的地址
2.写入数据。
 注入式填充==.rar
|
2楼
LOGO |
另一种情况(即后备生源区域有效数据间存在空值)的处理：
数据及要求如下：
 other.jpg
代码如下：- Sub 注入二()
- Dim 空值 As Range, 备选 As Range, 个数 As Integer, brr(), crr(), i As Integer
- Set 空值 = Range("F3:I11")
- Set 备选 = Range("B3:D11")
- Application.ScreenUpdating = False
- Application.Calculation = xlCalculationManual
- For 个数 = 1 To 空值.Count
- If 空值(个数) = "" Then
- i = i + 1
- ReDim Preserve brr(1 To i)
- brr(i) = 空值(个数).Address
- End If
- Next
- i = 0
- For 个数 = 1 To 空值.Count '由于有多少个空值就注入多少个备选数据,所以用空值.count
- If 备选(个数) <> "" Then
- i = i + 1
- ReDim Preserve crr(1 To i)
- crr(i) = 备选(个数)
- End If
- Next
- For i = 1 To UBound(brr) 'ubound(brr) 也可以用 空值.count来代替
- Range(brr(i)).Value = crr(i)
- Next
- Application.ScreenUpdating = True
- Application.Calculation = xlCalculationAutomatic
- End Sub
注入式填充2.rar
|
3楼
LOGO |
更优的解法可参考此帖
2楼天南地北版主的数组法:知识点:可以任意修改数组中的元素 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一