- ©«¤l
- 976
- ¥DÃD
- 7
- ºëµØ
- 0
- ¿n¤À
- 1018
- ÂI¦W
- 0
- §@·~¨t²Î
- Win10
- ³nÅ骩¥»
- Office 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-4-19
- ³Ì«áµn¿ý
- 2024-12-18
|
¤£·|¨âÓ°Ï°ì³£¦³¸ê®Æ¡A¥u·|¦³¨ä¤¤¤@Ó
ÅÚ½³ªd µoªí©ó 2021-11-25 13:34
½Ð¦A¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test2()
Dim Arr, Brr(1 To 1000, 1 To 3), Crr()
Dim i&, j&, n%, s%, m%, R%
If [n13] <> "" Then
Arr = [n13].CurrentRegion '¨Ó·½¸ê®Æ1
For j = 1 To UBound(Arr, 2): For i = 1 To UBound(Arr)
If Arr(i, j) <> "" Then
If n < 7 Then n = n + 1 Else n = 1
s = s + 1: Brr(s, 1) = n
Brr(s, 2) = Arr(i, j): Brr(s, 3) = s
End If
Next i: Next j
ElseIf [k13] <> "" Then
Arr = Range([k13], [k65536].End(3)) '¨Ó·½¸ê®Æ2
For i = 1 To UBound(Arr)
If Arr(i, 1) <> "" Then
s = s + 1: Brr(s, 2) = Arr(i, 1)
End If
Next
End If
R = Int(s / 7) + 1: ReDim Crr(1 To R, 1 To 7): k = 1
For i = 1 To s
For j = 1 To 7
m = m + 1: If m > s Then GoTo 99
Crr(i, j) = Brr(m, 2)
Next
99: Next i
Range("a13").Resize(R, 7) = Crr 'Âà¶K¨ì3
End Sub
|
|