代码如何实现 求助代码

1吧吧

代码如何实现 求助代码

明天会更好zj

你这个问题，和你实际需求肯定相差很大，问的也模棱两可的。

无关岁月

Sub 按钮1_Click()
Dim arr, t, i
arr = Sheet2.[a1].CurrentRegion
t = Mid([b1], 3, 2)
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
    brr(i, 1) = t & Left(arr(i, 1), 1)
Next
Sheet4.[c1].Resize(UBound(brr)) = brr
End Sub

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, i&
   
    ar = Worksheets(1).[A1].CurrentRegion.Value
    For i = 1 To UBound(ar)
        ar(i, 1) = Mid(ar(1, 2), 3, 2) & Mid(ar(i, 1), 1, 1)
    Next i
   
    [D1].Resize(UBound(ar)) = ar
    Beep
End Sub

gwjkkkkk

。。。。。。。。。。。

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.8.3
   
2.     arr = Sheets("Sheet2").[a1].CurrentRegion
   
3.     ReDim brr(1 To UBound(arr), 1 To 1)
   
4.     For i = 1 To UBound(arr)
   
5.         m = m + 1
   
6.         brr(m, 1) = Mid(arr(1, 2), 3, 2) & Left(arr(i, 1), 1)
   
7.     Next
   
8.     With Sheets("Sheet3")
   
9.         .[B:B] = ""
   
10.         .[b1].Resize(m, 1) = brr
    
11.     End With
    
12. End Sub
    
13. 
    

复制代码

1吧吧

1吧吧

Sub TEST1()
    Dim ar, i&
    ar = Worksheets(1).[A1].CurrentRegion.Value
    For i = 1 To UBound(ar)
        ar(i, 1) = Mid(ar(1, 2), 3, 2) & Mid(ar(i, 1), 2, 1)
    Next i
    [b1].Resize(UBound(ar)) = ar
    Beep
End Sub

Sub TEST2()
    Dim ar, i&
    ar = Worksheets(1).[A1].CurrentRegion.Value
    For i = 1 To UBound(ar)
        ar(i, 1) = Mid(ar(1, 3), 1, 2) & Mid(ar(i, 1), 1, 1)
    Next i
    [c1].Resize(UBound(ar)) = ar
    Beep
End Sub

Qs18

Sub qs()
    Dim arr, i, s
    arr = Sheet2.Range("a1").CurrentRegion.Value
    ReDim brr(1 To UBound(arr), 1 To 1)
    s = Mid(arr(1, 2), 3, 2)
    For i = 1 To UBound(arr)
        brr(i, 1) = s & Left(arr(i, 1), 1)
    Next
    Sheet4.Range("b1").Resize(UBound(arr), 1) = brr
    Beep
End Sub