去掉空格提取内容

sanpiao

去掉空格提取内容

lisongmei

1. Sub r_w()
   
2. Dim arr
   
3. Dim arr1(1 To 1000, 1 To 5)
   
4. Dim i, j, k As Integer
   
5. Dim sr As String
   
6. Range("H2:L12").ClearContents
   
7. arr = Range("B2:F12")
   
8. For i = 1 To UBound(arr)
   
9.     sr = ""
   
10.     For j = 1 To UBound(arr, 2)
    
11.         sr = sr & arr(i, j)
    
12.     Next
    
13.     If Len(sr) > 0 Then
    
14.         k = k + 1
    
15.         For j = 1 To 5
    
16.             arr1(k, j) = arr(i, j)
    
17.         Next
    
18.     End If
    
19.     sr = ""
    
20. Next
    
21. Range("h2").Resize(k, 5) = arr1
    
22. End Sub

复制代码

sanpiao

lisongmei 发表于 2021-9-21 14:12

能用公式吗

lisongmei

sanpiao 发表于 2021-9-21 14:15
能用公式吗

365有这公式，其他版本想实现公式估计有点难，我不擅长，你只能等其他答案了

=UNIQUE(B2:F12)

hcm19522

H2:L2 下拉 {=INDEX(B:B,SMALL(IF(MMULT(N($B$2:$F$12<>""),Z1:Z5+1),ROW($2:$12),99),ROW(A1)))&""

tgydslr

H2

1. =INDIRECT("R"&SMALL(IF($B$2:$B$12<>"",ROW($A$2:$A$12),99),ROW(A1))&"C"&COLUMN(B1),)&""
   

复制代码

OK哈了哨

=OFFSET($A$1,SMALL(IF($B$2:$B$12<>"",ROW($1:$11),99),ROW(A1)),COLUMN(A1))&""