- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«¥H¸ê®Æªí½m²ß¦X¨ÖÀx¦s®æ§P©w»P°}¦C°µ¥X¹ÎÁÊ©ú²Ó¨Ã³]©w¦C¦L½d³ò,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
¸ê®Æªí:
°õ¦æ«áµ²ªGªí:
Option Explicit
Sub TEST_20240328_1()
Dim xR As Range, Brr, i%, j%, T$, Crr, R%
ReDim Crr(1 To 1000, 1 To 6)
With Sheets("½s¸¹")
Brr = .UsedRange
For j = 1 To UBound(Brr, 2) Step 3
For i = 1 To UBound(Brr)
Set xR = .Cells(i, j): If xR.MergeArea.Cells.Count = 2 And xR <> "" And xR <> T Then T = xR: GoTo i01
R = R + 1: Crr(R, 1) = R: Crr(R, 2) = T: Crr(R, 3) = Brr(i, j): Crr(R, 4) = Brr(i, j + 1)
i01: Next
Next
End With
Workbooks.Add: [A1].Resize(, 6) = [{"NO.","¾ºÙ","©m¦W","¤Hû½s¸¹","¹ÎÁÊ©ú²Ó","Á`ª÷ÃB"}]
With [A2].Resize(R, 6)
.Value = Crr
.Columns(5).ColumnWidth = 25
.Borders.LineStyle = 1
Range([A1], .Cells).Name = "'" & ActiveSheet.Name & "'!Print_Area"
End With
End Sub |
|