ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

¤À§O³æ¿WÀx¦s¦¨EXCELÀÉ

¦^´_ 1# koala2099
  1. Private Sub CommandButton1_Click()
  2. '======¿z¿ï¦³´X­Ó­Ü®w===========
  3.     Sheet1.Range("B2:B65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet1.Range( _
  4.         "P2"), Unique:=True
  5.         
  6. A = Sheet1.Range("P65536").End(xlUp).Row       '¦@¦³´X­Ó­Ü®w
  7. B = Sheet1.Range("C65536").End(xlUp).Row       '¦@¦³¦h¤Öµ§¸ê®Æ­n³Q°õ¦æ
  8. With Application.FileDialog(msoFileDialogFolderPicker)
  9.     If .Show = 0 Then Exit Sub
  10.     patch = .SelectedItems(1)
  11.     Application.DefaultFilePath = patch
  12.     If .ButtonName = "½T©w" Then
  13.         For I = 2 To A
  14.             Workbooks.Add
  15.             ActiveWorkbook.Sheets(1).Name = Sheet1.Range("P" & I)
  16.             With ActiveWorkbook
  17.             Sheet1.Range("A1:J1").Copy .Sheets(1).Range("A1")
  18.             For J = 2 To B
  19.                 If Sheet1.Range("P" & I) = Sheet1.Range("B" & J) Then
  20.                    .Sheets(1).Range("A" & 2 + N) = Sheet1.Range("A" & J)
  21.                    .Sheets(1).Range("B" & 2 + N) = Sheet1.Range("B" & J)
  22.                    .Sheets(1).Range("C" & 2 + N) = Sheet1.Range("C" & J)
  23.                    .Sheets(1).Range("D" & 2 + N) = Sheet1.Range("D" & J)
  24.                    .Sheets(1).Range("E" & 2 + N) = Sheet1.Range("E" & J)
  25.                    .Sheets(1).Range("F" & 2 + N) = Sheet1.Range("F" & J)
  26.                    .Sheets(1).Range("G" & 2 + N) = Sheet1.Range("G" & J)
  27.                    .Sheets(1).Range("H" & 2 + N) = Sheet1.Range("H" & J)
  28.                    .Sheets(1).Range("I" & 2 + N) = Sheet1.Range("I" & J)
  29.                    .Sheets(1).Range("J" & 2 + N) = Sheet1.Range("J" & J)
  30.                    N = N + 1
  31.                 End If
  32.             Next
  33.             .SaveAs Application.DefaultFilePath & "\" & Sheet1.Range("P" & I)
  34.             .Close
  35.             End With
  36.             N = 0
  37.         Next
  38.     End If
  39. End With
  40. Sheet1.Range("P:P").Delete
  41. ActiveWorkbook.Save
  42. End Sub
½Æ»s¥N½X
¾Ç²ß¤~¯à´£¤É¦Û¤v

TOP

        ÀR«ä¦Û¦b : ­n¥Î¤ß¡A¤£­n¾Þ¤ß¡B·Ð¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD