b列数据按d列编号提取

CAONI

1、b5列各单元格中填有数字、文本且每6行为一组即b5:b10、b11:b10...每组数据从上到下编号为1到6等。

2、d5列各单元格从上到下填有数据，每个数据的大小代表b5列各小组数据编号位置。

3、按照d5列编号数提取b5列各组对应编号数字：d列数字1换成b列各组第1号位置的数字,d列数字2换成b列各组第2号位置的   数字,其他依次。

4、首先提取b列第1组数据然后第2组、第3组...各组数据依次提取其结果填在f5列。

5、各组第2次替换的数据填在第1次替换的数据后面，第3次替换的数据填在第2次替换的数据后面，依次。


按编号提取.rar (7.68 KB, 下载次数: 7)

2022-12-11 11:07 上传

点击文件名下载附件

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     With Worksheets("sheet1")
   
5.         r = .Cells(.Rows.Count, 2).End(xlUp).Row
   
6.         arr = .Range("b5:b" & r)
   
7.         r = .Cells(.Rows.Count, 4).End(xlUp).Row
   
8.         brr = .Range("d5:d" & r)
   
9.         ReDim crr(1 To UBound(arr), 1 To 1)
   
10.         m = 0
    
11.         For i = 1 To UBound(arr) Step 6
    
12.             For j = 1 To UBound(brr)
    
13.                 m = m + 1
    
14.                 If i + brr(j, 1) - 1 < UBound(arr) Then
    
15.                     crr(m, 1) = arr(i + brr(j, 1) - 1, 1)
    
16.                 End If
    
17.             Next
    
18.         Next
    
19.         .Range("f5").Resize(UBound(crr), 1) = crr
    
20.     End With
    
21. End Sub
    

复制代码

chxw68

详见附件。

CAONI

chxw68 发表于 2022-12-11 11:19
详见附件。

这么快，老师厉害！，程序满足要求，谢谢！