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

[µo°Ý] ½Ð°Ý­n¦p¦ó²¤Æ/§ó§ïVBA, §¹¦¨©¹«áªºOrder©O?

¦^´_ 8# boomf2


        Sub ¦Û°Ê·s¼W¤é¤u§@ï§ó·s()

¥»ÀɦW = ActiveWorkbook.Name
¥»¸ô®| = ActiveWorkbook.Path


'***********************************************§ä¥Xa©±001¦ì¸m***********************************
For aaa = 1 To 20
On Error Resume Next
©±¦WÄæ¦ì = Sheets("Total").Rows(aaa).Find(What:="A©±001", LookIn:=xlValues, SearchDirection:=xlPrevious).Column
On Error GoTo 0
Next

For aaa = 1 To ©±¦WÄæ¦ì
On Error Resume Next
©±¦W¦C¦ì = Sheets("Total").Columns(aaa).Find(What:="A©±001", LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlPrevious).Row
On Error GoTo 0
Next
'***********************************************§ä¥Xa©±001¦ì¸m***********************************




'***********************************************§ä¥X³Ì«á¤@¶¡©±¦ì¸m***********************************
©±¦W³Ì«áÄæ¦ì = Sheets("Total").Rows(©±¦W¦C¦ì).Find(What:="*", LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlPrevious).Column
'***********************************************§ä¥X³Ì«á¤@¶¡©±¦ì¸m***********************************




'***********************************************§ä¥X²£«~¼Æ¶q***********************************
²£«~codeÄæ = Sheets("Total").Rows(©±¦W¦C¦ì).Find(What:="²£«~CODE", LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlPrevious).Column

²£«~code¦C = Sheets("Total").Columns(²£«~codeÄæ).Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Row

²£«~Á`¼Æ = ²£«~code¦C - ©±¦W¦C¦ì
'***********************************************§ä¥X²£«~¼Æ¶q***********************************


'***********************************************Åý¤§«á°j°é¥Î***********************************
²£«~°_©l¦C©w¦ì = ©±¦W¦C¦ì + 1
²£«~µ²§ô¦C©w¦ì = ²£«~code¦C
'***********************************************Åý¤§«á°j°é¥Î***********************************

''*************************¨ä¥L¸ê°T*************************
¤é´Á¼È¦s = Workbooks(¥»ÀɦW).Sheets("Total").[G1]

''*************************¨ä¥L¸ê°T*************************





'*************************¬y¤ô¸¹°j°é°_©l­È*************************
¬y¤ô = 1
'*************************¬y¤ô¸¹°j°é°_©l­È*************************

While ©±¦WÄæ¦ì < ©±¦W³Ì«áÄæ¦ì + 1

If Workbooks(¥»ÀɦW).Sheets("Total").Cells(7, ©±¦WÄæ¦ì) = "K" Then '°²¦p¬OK´N°µ
   
    ©±¦W = Workbooks(¥»ÀɦW).Sheets("Total").Cells(©±¦W¦C¦ì, ©±¦WÄæ¦ì)


    ¥XÀɸ¹ = "order" & ¬y¤ô
    Set nX = Workbooks.Add


    Application.DisplayAlerts = False
   
    If ActiveWorkbook.Sheets.Count = 3 Then
    ActiveWorkbook.Sheets(3).Delete
    End If
    If ActiveWorkbook.Sheets.Count = 2 Then
    ActiveWorkbook.Sheets(2).Delete
    End If
    ActiveWorkbook.Sheets(1).Name = ©±¦W
   

    ²£«~¹Bºâ¦C = ²£«~°_©l¦C©w¦ì
    ²£«~°±ºâ¦C = ²£«~µ²§ô¦C©w¦ì

        orderrow = 1
        While ²£«~¹Bºâ¦C < ²£«~°±ºâ¦C + 1
          If Workbooks(¥»ÀɦW).Sheets("Total").Cells(²£«~¹Bºâ¦C, ©±¦WÄæ¦ì) <> "" Then
   
              ActiveWorkbook.Sheets(1).Cells(orderrow, 1) = "DK"
              ActiveWorkbook.Sheets(1).Cells(orderrow, 3) = ¤é´Á¼È¦s
              ActiveWorkbook.Sheets(1).Cells(orderrow, 4) = "DN"
               ActiveWorkbook.Sheets(1).Cells(orderrow, 5) = "B99"
              ActiveWorkbook.Sheets(1).Cells(orderrow, 6) = "©±¦W"
               ActiveWorkbook.Sheets(1).Cells(orderrow, 7) = Workbooks(¥»ÀɦW).Sheets("Total").Cells(²£«~¹Bºâ¦C, ²£«~codeÄæ).Value
              ActiveWorkbook.Sheets(1).Cells(orderrow, 8) = Workbooks(¥»ÀɦW).Sheets("Total").Cells(²£«~¹Bºâ¦C, ²£«~codeÄæ + 3).Value
              ActiveWorkbook.Sheets(1).Cells(orderrow, 9) = Workbooks(¥»ÀɦW).Sheets("Total").Cells(²£«~¹Bºâ¦C, ©±¦WÄæ¦ì)
               orderrow = orderrow + 1
         End If
   
   
     ²£«~¹Bºâ¦C = ²£«~¹Bºâ¦C + 1
        Wend

    nX.SaveAs ThisWorkbook.Path & "/" & ¥XÀɸ¹ & ©±¦W
    nX.Close
   



End If  '°²¦p¬OK µ²§ô

¬y¤ô = ¬y¤ô + 1
©±¦WÄæ¦ì = ©±¦WÄæ¦ì + 1
Wend


End Sub


K­È¤~·|°µ
­×¥¿¤u§@ªí¼Æ¶q§R°£

TOP

  1. Sub ¦Û°Ê·s¼W¤é¤u§@ï§ó·s()


  2. Application.DisplayAlerts = False
  3. Application.ScreenUpdating = False
  4. ¥»ÀɦW = ActiveWorkbook.Name
  5. ¥»¸ô®| = ActiveWorkbook.Path

  6. ©±¦W¶}ÀY¯Á¤Þ = "A©±001"

  7. '***********************************************§ä¥Xa©±001¦ì¸m***********************************
  8. For aaa = 1 To 20
  9. On Error Resume Next
  10. ©±¦WÄæ¦ì = Sheets("Total").Rows(aaa).Find(What:=©±¦W¶}ÀY¯Á¤Þ, LookIn:=xlValues, SearchDirection:=xlNext).Column
  11. On Error GoTo 0
  12. Next

  13. For aaa = 1 To ©±¦WÄæ¦ì
  14. On Error Resume Next
  15. ©±¦W¦C¦ì = Sheets("Total").Columns(aaa).Find(What:=©±¦W¶}ÀY¯Á¤Þ, LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlNext).Row
  16. On Error GoTo 0
  17. Next
  18. '***********************************************§ä¥Xa©±001¦ì¸m***********************************




  19. '***********************************************§ä¥X³Ì«á¤@¶¡©±¦ì¸m***********************************
  20. ©±¦W³Ì«áÄæ¦ì = Sheets("Total").Rows(©±¦W¦C¦ì).Find(What:="*", LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlPrevious).Column
  21. '***********************************************§ä¥X³Ì«á¤@¶¡©±¦ì¸m***********************************




  22. '***********************************************§ä¥X²£«~¼Æ¶q***********************************
  23. ²£«~codeÄæ = Sheets("Total").Rows(©±¦W¦C¦ì).Find(What:="²£«~CODE", LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlPrevious).Column

  24. ²£«~code¦C = Sheets("Total").Columns(²£«~codeÄæ).Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Row

  25. ²£«~Á`¼Æ = ²£«~code¦C - ©±¦W¦C¦ì
  26. '***********************************************§ä¥X²£«~¼Æ¶q***********************************


  27. '***********************************************Åý¤§«á°j°é¥Î***********************************
  28. ²£«~°_©l¦C©w¦ì = ©±¦W¦C¦ì + 1
  29. ²£«~µ²§ô¦C©w¦ì = ²£«~code¦C
  30. '***********************************************Åý¤§«á°j°é¥Î***********************************

  31. ''*************************¨ä¥L¸ê°T*************************
  32. ¤é´Á¼È¦s = Workbooks(¥»ÀɦW).Sheets("Total").[G1]
  33. ©±®a·s¼W¼Æ¶q = 0
  34. ©±®a·s¼W©±¦W = "·s¼W©±¦W:"
  35. ''*************************¨ä¥L¸ê°T*************************





  36. '*************************¬y¤ô¸¹°j°é°_©l­È*************************
  37. ¬y¤ô = 1
  38. '*************************¬y¤ô¸¹°j°é°_©l­È*************************

  39. While ©±¦WÄæ¦ì < ©±¦W³Ì«áÄæ¦ì + 1
  40. If UCase(Workbooks(¥»ÀɦW).Sheets("Total").Cells(7, ©±¦WÄæ¦ì)) = "K" Then    '°²¦p¬Ok­È ´N¤£·|·s¼W


  41.     ©±¦W = Workbooks(¥»ÀɦW).Sheets("Total").Cells(©±¦W¦C¦ì, ©±¦WÄæ¦ì)
  42.     ©±®a·s¼W©±¦W = ©±®a·s¼W©±¦W & vbCrLf & ©±¦W
  43.    
  44.     ¥XÀɸ¹ = "order" & ¬y¤ô
  45.     Set nX = Workbooks.Add


  46.     Application.DisplayAlerts = False
  47.    
  48.     If ActiveWorkbook.Sheets.Count = 3 Then
  49.     ActiveWorkbook.Sheets(3).Delete
  50.     End If
  51.     If ActiveWorkbook.Sheets.Count = 2 Then
  52.     ActiveWorkbook.Sheets(2).Delete
  53.     End If
  54.     ActiveWorkbook.Sheets(1).Name = ©±¦W


  55.     ²£«~¹Bºâ¦C = ²£«~°_©l¦C©w¦ì
  56.     ²£«~°±ºâ¦C = ²£«~µ²§ô¦C©w¦ì

  57.     orderrow = 1
  58.     While ²£«~¹Bºâ¦C < ²£«~°±ºâ¦C + 1
  59.         If Workbooks(¥»ÀɦW).Sheets("Total").Cells(²£«~¹Bºâ¦C, ©±¦WÄæ¦ì) <> "" Then
  60.    
  61.             ActiveWorkbook.Sheets(1).Cells(orderrow, 1) = "DK"
  62.             ActiveWorkbook.Sheets(1).Cells(orderrow, 3) = ¤é´Á¼È¦s
  63.             ActiveWorkbook.Sheets(1).Cells(orderrow, 4) = "DN"
  64.             ActiveWorkbook.Sheets(1).Cells(orderrow, 5) = "B99"
  65.             ActiveWorkbook.Sheets(1).Cells(orderrow, 6) = "©±¦W"
  66.             ActiveWorkbook.Sheets(1).Cells(orderrow, 7) = Workbooks(¥»ÀɦW).Sheets("Total").Cells(²£«~¹Bºâ¦C, ²£«~codeÄæ).Value
  67.             ActiveWorkbook.Sheets(1).Cells(orderrow, 8) = Workbooks(¥»ÀɦW).Sheets("Total").Cells(²£«~¹Bºâ¦C, ²£«~codeÄæ + 3).Value
  68.             ActiveWorkbook.Sheets(1).Cells(orderrow, 9) = Workbooks(¥»ÀɦW).Sheets("Total").Cells(²£«~¹Bºâ¦C, ©±¦WÄæ¦ì)
  69.             orderrow = orderrow + 1
  70.         End If
  71.    
  72.    
  73.     ²£«~¹Bºâ¦C = ²£«~¹Bºâ¦C + 1
  74.     Wend

  75.     nX.SaveAs ThisWorkbook.Path & "/" & ¥XÀɸ¹ & ©±¦W
  76.     nX.Close
  77.     ©±®a·s¼W¼Æ¶q = ©±®a·s¼W¼Æ¶q + 1
  78. End If

  79. ¬y¤ô = ¬y¤ô + 1
  80. ©±¦WÄæ¦ì = ©±¦WÄæ¦ì + 1
  81. Wend


  82. MsgBox "¦@" & ©±®a·s¼W¼Æ¶q & "©±®a¸ê®Æ·s¼W" & vbCrLf & ©±®a·s¼W©±¦W
  83. End Sub
½Æ»s¥N½X
'­×¥¿§R°£¤u§@ªí
'·s¼W§PÂ_K­È
'¤Ï¹L¨Ó·j´M°_©lÂI"A©±001"ªº¦ì¸m
'·s¼W«Ø¥ßµ§¼Æ»P©±®a¦WºÙ

TOP

©êºp¦³ÂI¬~¤å³¹¤F

¦pªG»¡ §AªºÀɦW ¤£­n¦³order1ªº¸Ü

¦bsaveas ¨º­Ó¦ì¸m,§â   & ¥XÀɸ¹    µ¹§R±¼

¤U­±³o¼Ë
  1. Sub ¦Û°Ê·s¼W¤é¤u§@ï§ó·s()


  2. Application.DisplayAlerts = False
  3. Application.ScreenUpdating = False
  4. ¥»ÀɦW = ActiveWorkbook.Name
  5. ¥»¸ô®| = ActiveWorkbook.Path

  6. ©±¦W¶}ÀY¯Á¤Þ = "A©±001"

  7. '***********************************************§ä¥Xa©±001¦ì¸m***********************************
  8. For aaa = 1 To 20
  9. On Error Resume Next
  10. ©±¦WÄæ¦ì = Sheets("Total").Rows(aaa).Find(What:=©±¦W¶}ÀY¯Á¤Þ, LookIn:=xlValues, SearchDirection:=xlNext).Column
  11. On Error GoTo 0
  12. Next

  13. For aaa = 1 To ©±¦WÄæ¦ì
  14. On Error Resume Next
  15. ©±¦W¦C¦ì = Sheets("Total").Columns(aaa).Find(What:=©±¦W¶}ÀY¯Á¤Þ, LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlNext).Row
  16. On Error GoTo 0
  17. Next
  18. '***********************************************§ä¥Xa©±001¦ì¸m***********************************




  19. '***********************************************§ä¥X³Ì«á¤@¶¡©±¦ì¸m***********************************
  20. ©±¦W³Ì«áÄæ¦ì = Sheets("Total").Rows(©±¦W¦C¦ì).Find(What:="*", LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlPrevious).Column
  21. '***********************************************§ä¥X³Ì«á¤@¶¡©±¦ì¸m***********************************




  22. '***********************************************§ä¥X²£«~¼Æ¶q***********************************
  23. ²£«~codeÄæ = Sheets("Total").Rows(©±¦W¦C¦ì).Find(What:="²£«~CODE", LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlPrevious).Column

  24. ²£«~code¦C = Sheets("Total").Columns(²£«~codeÄæ).Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Row

  25. ²£«~Á`¼Æ = ²£«~code¦C - ©±¦W¦C¦ì
  26. '***********************************************§ä¥X²£«~¼Æ¶q***********************************


  27. '***********************************************Åý¤§«á°j°é¥Î***********************************
  28. ²£«~°_©l¦C©w¦ì = ©±¦W¦C¦ì + 1
  29. ²£«~µ²§ô¦C©w¦ì = ²£«~code¦C
  30. '***********************************************Åý¤§«á°j°é¥Î***********************************

  31. ''*************************¨ä¥L¸ê°T*************************
  32. ¤é´Á¼È¦s = Workbooks(¥»ÀɦW).Sheets("Total").[G1]
  33. ©±®a·s¼W¼Æ¶q = 0
  34. ©±®a·s¼W©±¦W = "·s¼W©±¦W:"
  35. ''*************************¨ä¥L¸ê°T*************************





  36. '*************************¬y¤ô¸¹°j°é°_©l­È*************************
  37. ¬y¤ô = 1
  38. '*************************¬y¤ô¸¹°j°é°_©l­È*************************

  39. While ©±¦WÄæ¦ì < ©±¦W³Ì«áÄæ¦ì + 1
  40. If UCase(Workbooks(¥»ÀɦW).Sheets("Total").Cells(7, ©±¦WÄæ¦ì)) = "K" Then    '°²¦p¬Ok­È ´N¤£·|·s¼W


  41.     ©±¦W = Workbooks(¥»ÀɦW).Sheets("Total").Cells(©±¦W¦C¦ì, ©±¦WÄæ¦ì)
  42.     ©±®a·s¼W©±¦W = ©±®a·s¼W©±¦W & vbCrLf & ©±¦W
  43.    
  44.     ¥XÀɸ¹ = "order" & ¬y¤ô
  45.     Set nX = Workbooks.Add


  46.     Application.DisplayAlerts = False
  47.    
  48.     If ActiveWorkbook.Sheets.Count = 3 Then
  49.     ActiveWorkbook.Sheets(3).Delete
  50.     End If
  51.     If ActiveWorkbook.Sheets.Count = 2 Then
  52.     ActiveWorkbook.Sheets(2).Delete
  53.     End If
  54.     ActiveWorkbook.Sheets(1).Name = ©±¦W


  55.     ²£«~¹Bºâ¦C = ²£«~°_©l¦C©w¦ì
  56.     ²£«~°±ºâ¦C = ²£«~µ²§ô¦C©w¦ì

  57.     orderrow = 1
  58.     While ²£«~¹Bºâ¦C < ²£«~°±ºâ¦C + 1
  59.         If Workbooks(¥»ÀɦW).Sheets("Total").Cells(²£«~¹Bºâ¦C, ©±¦WÄæ¦ì) <> "" Then
  60.    
  61.             ActiveWorkbook.Sheets(1).Cells(orderrow, 1) = "DK"
  62.             ActiveWorkbook.Sheets(1).Cells(orderrow, 3) = ¤é´Á¼È¦s
  63.             ActiveWorkbook.Sheets(1).Cells(orderrow, 4) = "DN"
  64.             ActiveWorkbook.Sheets(1).Cells(orderrow, 5) = "B99"
  65.             ActiveWorkbook.Sheets(1).Cells(orderrow, 6) = "©±¦W"
  66.             ActiveWorkbook.Sheets(1).Cells(orderrow, 7) = Workbooks(¥»ÀɦW).Sheets("Total").Cells(²£«~¹Bºâ¦C, ²£«~codeÄæ).Value
  67.             ActiveWorkbook.Sheets(1).Cells(orderrow, 8) = Workbooks(¥»ÀɦW).Sheets("Total").Cells(²£«~¹Bºâ¦C, ²£«~codeÄæ + 3).Value
  68.             ActiveWorkbook.Sheets(1).Cells(orderrow, 9) = Workbooks(¥»ÀɦW).Sheets("Total").Cells(²£«~¹Bºâ¦C, ©±¦WÄæ¦ì)
  69.             orderrow = orderrow + 1
  70.         End If
  71.    
  72.    
  73.     ²£«~¹Bºâ¦C = ²£«~¹Bºâ¦C + 1
  74.     Wend

  75.     nX.SaveAs ThisWorkbook.Path & "/" & ©±¦W
  76.     nX.Close
  77.     ©±®a·s¼W¼Æ¶q = ©±®a·s¼W¼Æ¶q + 1
  78. End If

  79. ¬y¤ô = ¬y¤ô + 1
  80. ©±¦WÄæ¦ì = ©±¦WÄæ¦ì + 1
  81. Wend


  82. MsgBox "¦@" & ©±®a·s¼W¼Æ¶q & "©±®a¸ê®Æ·s¼W" & vbCrLf & ©±®a·s¼W©±¦W
  83. End Sub
½Æ»s¥N½X

TOP

¦^´_ 10# ­ã´£³¡ªL


ThanksBros

§Ú¤w¸g¦A¥[¶i¤F«Ü¦hªFªF
³o¦¸¾Ç·|¤F«Ü§Öªº¤èªk¥h³B²z©M±±¨î¸ê®Æ½d³ò!
,ÁÂÁ«ü¾É=] !

TOP

        ÀR«ä¦Û¦b : §Ú­Ì­n°µ¦nªÀ·|ªºÀô«O¡A¤]­n°µ¦n¤º¤ßªºÀô«O¡C
ªð¦^¦Cªí ¤W¤@¥DÃD