Andy2483

¦^´_ 1# JT1221


    ¥tÃþ¬d¸ß¤è¦¡¨Ñ«e½ú°Ñ¦Ò
ÁÂÁ«e½úµoªí¦¹©«

Option Explicit
Sub test()
Dim i, x, Arr, Brr(1 To 100000, 1 To 9), c, j, n, Crr
Arr = Sheets("Á`ªí").Range("A1").CurrentRegion
Crr = Sheets("¬d¸ß").Range("A1").CurrentRegion
c = Sheets("Á`ªí").UsedRange.Columns.Count
For i = 1 To UBound(Arr)
   For j = 8 To c
      If Trim(Arr(i, j)) = "" Or Trim(Arr(i, j)) = "A=B,A=C¡÷B=C" Then
         Exit For
         Else
            n = n + 1
            Brr(n, 8) = Trim(Arr(i, j))
            For x = 1 To 7
               Brr(n, x) = Trim(Arr(i, x))
            Next
      End If
   Next
Next
Workbooks.Add
Cells.Font.Name = "·L³n¥¿¶ÂÅé"
[A1].Resize(100000, 9) = Brr
Cells.Columns.AutoFit
Cells.Rows.AutoFit
Cells.Columns.AutoFit
[2:2].Select
ActiveWindow.FreezePanes = True
[A1].AutoFilter
[A1].Select
ActiveSheet.Name = "·sÁ`ªí"
Sheets.Add.Name = "·s¬d¸ß"
[A1].Resize(UBound(Crr), 4) = Crr
For i = 1 To UBound(Crr)
   For x = 2 To UBound(Brr)
      If Brr(x, 1) = Crr(i, 1) Then
         If Crr(i, 2) = "" Then
            Crr(i, 2) = Brr(x, 3)
         End If
         If Crr(i, 3) = "" Then
            Crr(i, 3) = Brr(x, 6)
         End If
         If Crr(i, 4) = "" Then
            Crr(i, 4) = Brr(x, 8)
            Else
               Crr(i, 4) = Crr(i, 4) & vbLf & Brr(x, 8)
         End If
      End If
   Next
Next
[A1].Resize(UBound(Crr), 4) = Crr
[A:D].Columns.AutoFit
Cells.Rows.AutoFit
Cells.Borders.LineStyle = xlContinuous
[2:2].Select
ActiveWindow.FreezePanes = True
[A1].AutoFilter
[A1].Select
End Sub