如何根据列单元提取或者复制

xiaosheng666

请大家帮助如果用VBA，根据A列目录下面的每个单元格的数值，复制（提取）右边对应对应列的对应单元格内。

feilanga

.......................

无关岁月

相隔行号之间间距数填空.7z (15.82 KB, 下载次数: 13)

2023-11-17 11:47 上传

点击文件名下载附件

xiaosheng666

谢谢大家帮助！感谢！

saghj

Sub test2()
Dim i&, j&, arr, brr()
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr) - 1, 1 To 7)
For i = 2 To UBound(arr)
  For j = 2 To 8
    If arr(i, 1) = arr(1, j) Then
       brr(i - 1, j - 1) = arr(i, 1)
    Else
       brr(i - 1, j - 1) = ""
     End If
  Next j
Next i
[b2].Resize(UBound(brr), 7) = brr
End Sub
请指教

x-xx-xx

1. Sub Macro1()
   
2.    
   
3.     Dim 编号01_数组
   
4.     Dim 编号02_第几行
   
5.     Dim 编号03_第几列
   
6.    
   
7.     编号01_数组 = Range("A1:H20").Value
   
8.    
   
9.     For 编号02_第几行 = 2 To UBound(编号01_数组, 1) Step 1
   
10.         
    
11.         For 编号03_第几列 = 2 To UBound(编号01_数组, 2) Step 1
    
12.             
    
13.             If 编号01_数组(1, 编号03_第几列) = 编号01_数组(编号02_第几行, 1) Then
    
14.                
    
15.                 编号01_数组(编号02_第几行, 编号03_第几列) = 编号01_数组(编号02_第几行, 1)
    
16.                
    
17.             End If
    
18.             
    
19.         Next
    
20.         
    
21.     Next
    
22.    
    
23.     Range("A1").Resize(UBound(编号01_数组, 1), UBound(编号01_数组, 2)) = 编号01_数组
    
24.    
    
25. End Sub

复制代码

gwjkkkkk

参与一下。。。

caiyu93

直接复制的话,速度会很慢,这样基本秒出结果

xiaosheng666

谢谢！太感谢了！

x-xx-xx