½Ð°Ý¦Û°Ê´«¦æ®æ¦¡­n¦p¦ó©î¤À¨â¦æ ¤½¦¡¤ÎVBA°µªk?

aassddff736

½Ð°Ý¦Û°Ê´«¦æ®æ¦¡­n¦p¦ó©î¤À¨â¦æ ¤½¦¡¤ÎVBA°µªk?

¤U¸ü (49.24 KB)

2024-2-24 20:58

¦p¦ó§âA1Äæ²Ä¤@±Æ©ñB1Äæ¨ä¸ê®Æ©ñC1

aassddff736

¦^´_ 6# hcm19522

¤j¯«¨D§U
§Ú¸ÕµÛ­×§ï¦³¥H¤U¨â­Ó°ÝÃD

[    test2.rar (36.36 KB)

¤U¸ü¦¸¼Æ: 1

2024-2-27 21:51

]37516[/attachimg]
1."°O¿ýªí"§Ú³o¼Ë±a¦ü¥G¶]¤ÓºC,¸ò¤£¤W ¦C¦L³t«×

¤U¸ü (66.66 KB)

2024-2-27 21:49

2.¶À¦â¿Ã¥úµ§³¡¤À¦³·Q§ó²¼ä¤è¦¡¶Ü?

hcm19522

(·j´M½s¸¹12428) googleºô§}:https://hcm19522.blogspot.com/

Andy2483

¦^´_  Andy2483

¯uªº«Ü·PÁ±z
aassddff736 µoªí©ó 2024-2-26 11:35

Option Explicit
Sub ±Æ¦¨ªí·J¾ã¬°¾ã²zªí()
Dim Brr, Crr, i&, R&, xU As Range, xS As Worksheet
Set xS = Sheets("±Æµ{")
'¡ô¥OxSÅܼƬO "±Æµ{"¤u§@ªí
[¾ã²z!A1].CurrentRegion.Offset(1).EntireRow.Delete
'¡ô¥O"¾ã²z"ªí¯d¤U¼ÐÃD¦C,¨ä¥¦¦C§R°£
Brr = Range(xS.[D2], xS.[A65536])
'¡ô¥OBrrÅܼƬO¤Gºû°}¦C,¥HÀx¦s®æ­È±a¤J°}¦C¤¤
ReDim Crr(1 To UBound(Brr), 1 To 6)
'¡ô«Å§iCrrÅܼƬO¤GºûªÅ°}¦C,«Å§i¤W¤U ¥ª¥k½d³ò
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q1¨ì Brr°}¦C³Ì¤j¯Á¤Þ¦C¸¹
   If Trim(Brr(i, 2)) = "" Then GoTo i01 Else R = R + 1
   '¡ô¦pªGÃöÁäÄæªÅ®æ´N²¤¹L,§_«h´N¥ORÅܼƲ֥[1
   Crr(R, 1) = R
   Crr(R, 2) = Trim(Brr(i, 1))
   Crr(R, 3) = Trim(Brr(i, 2))
   Crr(R, 4) = Trim(Split(Brr(i, 3) & vbLf, vbLf)(0))
   Crr(R, 5) = Val(Brr(i, 4))
   Crr(R, 6) = Mid(Trim(Brr(i, 3)), InStr(Trim(Brr(i, 3)), vbLf) + 1)
   '¡ô±NBrr°}¦C­È¼g¤JCrr°}¦C¤¤
i01: Next
If R = 0 Then MsgBox "¨S¦³¸ê®Æ": Exit Sub
With [¾ã²z!A2].Resize(R, 6)
   .Value = Crr
   '¡ô±NCrr°}¦C­È¼g¤JÀx¦s®æ¤¤
   .Borders.LineStyle = xlContinuous
   '¡ô³]©w®æ½u
End With
End Sub

aassddff736

¦^´_ 2# Andy2483
½Ð±Ð¤@¤U~

¤U¸ü (88.91 KB)

2024-2-26 12:26

1.FÄæ¶Â¦â¦rÅé·QÅܦ¨ªÅ¥Õ¦p¦ó°µ?


ÀËÅç°O¿ýªí-A4--test.zip (33.95 KB)

¤U¸ü¦¸¼Æ: 2

2024-2-26 12:49

2.§Ú·Q¼W¥[¸ê®Æ¶µ¥Ø¦p§ó§ï?
3.§Ú·Q¤@¦¸©Ê¦C¦L «ç»ò§â¸ê®Æ±a¶iSHEET("°O¿ýªí")¤º

aassddff736

¦^´_ 2# Andy2483

¯uªº«Ü·PÁ±z

Andy2483

¦^´_ 1# aassddff736

"¾ã²z"ªí °õ¦æ«e:

¤U¸ü (32.5 KB)

2024-2-26 08:51

"¾ã²z"ªí °õ¦æµ²ªG:

¤U¸ü (56.1 KB)

2024-2-26 08:52

Option Explicit
Sub ±Æ¦¨ªí·J¾ã¬°¾ã²zªí()
Dim Brr, Crr, i&, R&, xU As Range, xS As Worksheet
Set xS = Sheets("±Æ¦¨")
[¾ã²z!A1].CurrentRegion.Offset(1).EntireRow.Delete
Brr = Range(xS.[D2], xS.[A65536])
ReDim Crr(1 To UBound(Brr), 1 To 6)
For i = 1 To UBound(Brr)
   If Trim(Brr(i, 2)) = "" Then GoTo i01 Else R = R + 1
   If InStr(Brr(i, 3), vbLf) Then
      If xU Is Nothing Then
         Set xU = Sheets("¾ã²z").Cells(R + 1, 6)
         Else
         Set xU = Union(xU, Sheets("¾ã²z").Cells(R + 1, 6))
      End If
   End If
   Crr(R, 1) = R
   Crr(R, 2) = Trim(Brr(i, 1))
   Crr(R, 3) = Trim(Brr(i, 2))
   Crr(R, 4) = Trim(Split(Brr(i, 3) & vbLf, vbLf)(0))
   Crr(R, 5) = Val(Brr(i, 4))
   Crr(R, 6) = Mid(Trim(Brr(i, 3)), InStr(Trim(Brr(i, 3)), vbLf) + 1)
i01: Next
If R = 0 Then MsgBox "¨S¦³¸ê®Æ": Exit Sub
With [¾ã²z!A2].Resize(R, 6)
   .Value = Crr
   .Borders.LineStyle = xlContinuous
End With
If Not xU Is Nothing Then xU.Font.ColorIndex = 3
End Sub