求助代码求助代码

1吧吧

求助代码求助代码

dragonthree

表2的B列-H列？后面几列是空的呀！这样你模拟结果别人也不知道后面几列怎么处理，是几列分别处理？结果还是分别存放在对应的列还是几列的结果合成一列？

1吧吧

dragonthree 发表于 2024-8-21 09:13
表2的B列-H列？后面几列是空的呀！这样你模拟结果别人也不知道后面几列怎么处理，是几列分别处理？结果还是 ...

分别存放在对应的列

1吧吧

分别存放在对应的列

dragonthree

1. Sub kj()
   
2. Dim arr, brr
   
3. Application.ScreenUpdating = False
   
4. With Sheets("Sheet2")
   
5.   arr = .Range("b1:h" & .Cells(.Rows.Count, 2).End(3).Row)
   
6. End With
   
7. ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
8. For i = 1 To UBound(arr)
   
9.    For j = 1 To UBound(arr, 2)
   
10.       brr(i, j) = Left(arr(i, j), 3)
    
11.    Next
    
12. Next
    
13. 
    
14. 
    
15. With Sheets("Sheet3")
    
16.      .Range("b1:b" & .Rows.Count).ClearContents
    
17.      .Range("b1").Resize(UBound(arr), UBound(arr, 2)) = brr
    
18. End With
    
19. 
    
20. 
    
21. Application.ScreenUpdating = True
    
22. 
    
23. MsgBox "OK!"
    
24. End Sub

复制代码

1吧吧

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, i&, j&
   
    ar = Worksheets(1).[B1].CurrentRegion.Value
    With Worksheets(2)
        For i = 1 To UBound(ar)
            For j = 1 To UBound(ar, 2)
                ar(i, j) = Left(ar(i, j), 3)
            Next j
        Next i
        .[B1].Resize(UBound(ar), UBound(ar, 2)) = ar
        .Activate
    End With
    Beep
End Sub

gwjkkkkk

。。。。。。。。。