- ©«¤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
|
¦^´_ 2# dou10801
ÁÂÁ«e½úµoªí¦¹©«
«á½ú¦³¨âºØ¬Ýªk
1.«O¯dì´«¦æ¤º®e>ªí2 DÄæÀx¦s®æ®æ¦¡³]¬°¤£´«¦æ
Sub DÄæÀx¦s®æ®æ¦¡³]¬°¤£´«¦æ()
Arr = Sheets("¤u§@ªí1").Range("A1:E" & Sheets("¤u§@ªí1").Cells(Rows.Count, 1).End(xlUp).Row)
ReDim brr(1 To Sheets("¤u§@ªí1").Cells(Rows.Count, 1).End(xlUp).Row, 1 To 5)
MS1 = 1
For i = 1 To UBound(Arr)
If Arr(i, 1) = "¤k" Then
brr(MS1, 1) = Arr(i, 1)
brr(MS1, 2) = Arr(i, 2)
brr(MS1, 3) = Arr(i, 3)
brr(MS1, 4) = Arr(i, 4)
brr(MS1, 5) = Arr(i, 5)
MS1 = MS1 + 1
End If
Next
Sheets("¤u§@ªí2").Range("A1:E1000") = ""
Sheets("¤u§@ªí2").Range("A1:E" & UBound(brr)) = brr
Sheets("¤u§@ªí2").[D:D].WrapText = False
Sheets("¤u§@ªí2").[D:D].Columns.AutoFit
End Sub
2.¥Î¨ú¥Nªº¤è¦¡±N´«¦æ¦r¤¸Âà´«¬°ªÅ¥Õ¦r¤¸
Option Explicit
Sub ²Å¦X±ø¥ó_Àx¦s®æ_´«¦æÂà´«ªÅ¥Õ¦r¤¸()
Dim Arr, i, x, MS1
Arr = Sheets("¤u§@ªí1").[A1].CurrentRegion
MS1 = 0
For i = 1 To UBound(Arr)
If Arr(i, 1) = "¤k" Then
MS1 = MS1 + 1
For x = 1 To 5
Arr(MS1, x) = Replace(Arr(i, x), vbLf, " ")
Next
End If
Next
With Sheets("¤u§@ªí2")
.[A:E].ClearContents
.[A1].Resize(MS1, 5) = Arr
.[D:D].Columns.AutoFit
End With
End Sub |
|