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

[µo°Ý] ¥t¦s·sÀÉ¡A¸ê®ÆÅçÃÒ

[µo°Ý] ¥t¦s·sÀÉ¡A¸ê®ÆÅçÃÒ

¥»©«³Ì«á¥Ñ lovenice831 ©ó 2021-1-25 12:15 ½s¿è

¦­«e½Ð±Ð¤F¦p¦ó§â¼Æ¾Ú¦Û°Ê¿é¤Jªí®æ¤¤¡A¦]ªí®æ§ó·s¤F¡A©Ò¥H§Ú§@¥X¤F§ï°Ê¡A¦ý§ï°Ê«á«K¥X²{¸ê®ÆÅçÃÒªº°ÝÃD¡A³s±a¥t¦sªºÀɮפ]¥X²{³o­Ó°ÝÃD¡A¤£ª¾¹D¬O§_§Úªº§ï°Ê¥X¤F°ÝÃD¡A¨D«üÂI¡AÁÂÁÂ
This Workbook
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name <> "Receiving Report" Then Exit Sub
With Target
     If .Address = "$J$6" Then Call ¸ü¤J¸ê®Æ
End With
End Sub
Module
Sub ­«¸m²M³æ()
Dim xS As Worksheet, Arr, xD, i&
Set xD = CreateObject("Scripting.Dictionary")
Set xS = Sheets("Receiving DATA")
Arr = Range(xS.[M1], xS.[M65536].End(xlUp)(4))
For i = 5 To UBound(Arr)
    If Arr(i, 1) <> "" Then xD(Arr(i, 1) & "") = ""
Next i
With ['Receiving Report'!J6]
    .Value = ""
    .Validation.Delete
    If xD.Count = 0 Then Exit Sub
    .Validation.Add Type:=xlValidateList, Formula1:=Join(xD.keys, ",")
End With
End Sub

Sub ²MªÅªí®æ()
Application.ScreenUpdating = False
With Sheets("Receiving Report")
     .Range("J8,C11:C12,F11,J11:J12,G12,G14:H14") = ""
     R& = .[A60000].End(xlUp).Row
     If R > 24 Then .Range("A22:A" & R - 3).EntireRow.Delete
     .Range("A20:H22") = ""
End With
End Sub

Sub ¸ü¤J¸ê®Æ()
Dim xS As Worksheet, Arr, Brr, i&, j%, T$, R&, N&
Call ²MªÅªí®æ
T = [J6]:  If T = "" Then Exit Sub
Set xS = Sheets("Receiving DATA")
R = xS.[M65536].End(xlUp).Row
Arr = xS.Range("A1:P" & R)
ReDim Brr(1 To 2000, 1 To 9)
For i = 5 To R
    If Arr(i, 13) & "" <> T Then GoTo 101
    N = N + 1
    If N = 1 Then
       [J8] = Arr(i, 5) 'Lot Number
       [C11] = Int(Arr(i, 2)): [F11] = TimeValue(Arr(i, 2)) '¦¬³f¤é´Á + ¦¬³f®É¶¡
       [C12] = Arr(i, 3): [J11] = Arr(i, 11) 'Âd¸¹/³fÆØ®ÆØ®µP + PO No.
       [G12] = Arr(i, 4): [J12] = Arr(i, 14) '«Ê¡ÓÈû¸¹ + BD­t³d¤H
     
    End If
    For j = 0 To 4: Brr(N, Array(1, 3, 4, 5, 8)(j)) = Arr(i, Array(9, 5, 7, 8, 10)(j)): Next
101: Next i
If N = 0 Then MsgBox "ÆØS¦³²Å¦X¸ê®Æ": Exit Sub
If N > 3 Then

   Range("A22").Resize(N - 3).EntireRow.Insert
   Range("A21:K21").Copy Range("A22").Resize(N - 3)
End If
Range("A20:H20").Resize(N) = Brr
[G14] = WorksheetFunction.Subtotal(3, [D20].Resize(N))
[H14] = WorksheetFunction.Sum([E20].Resize(N))
End Sub

Sub Save()
Dim R&, xS As Worksheet, xName$, xB As Workbook
Set xS = Sheets("Receiving Report")
xName = ThisWorkbook.Path & "\Receiving Report" & "_" & xS.[J8] & ".xlsx"   'save new file name
Application.ScreenUpdating = False
xS.Copy 'copy this sheets to a new sheets
Set xB = ActiveWorkbook
With xB.Sheets(1)
          For Each sp In ActiveSheet.Shapes
  If sp.Name Like "*Button*" Then sp.Delete  
  Next
End With
Application.DisplayAlerts = False 'if save name is here not warnning to save new file
xB.SaveAs xName, CreateBackup:=False 'save as
xB.Close 0
MsgBox "~~save complate~~ "
End Sub
0125_Receiving Data.zip (155.78 KB) Receiving Report_BAD-211034.zip (58.23 KB)
001.jpg
2021-1-25 12:12
002.jpg
2021-1-25 12:13

1) ²M³æ¤å¦r¶W¹L­­¨î¦Óµo¥Í¿ù»~, §ï¥Î²M³æ¨Ó·½¦ì§}
2) MÄæ¥Î¨Ó¦s©ñ²M³æ, ¥iÁôÂÃ
3) ¥t¦s·sÀÉ®É, J6¤U©Ô²M³æÅçÃÒÀ³²M°£(¤w¨S¨Ï¥Î·N¸q)
0125_Receiving Data-1.rar (149.58 KB)

TOP

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


    ÁÂÁ¤j¤jªº«ü¾É¡A§ÚÁÙ¦³¤@­Ó°ÝÃD¡A«ç¼Ë¤~¯à¦b¥t¦s·sÀɮɧâ¤U©Ô²M³æ²M°£©O?  ÁÂÁÂ

TOP

¦^´_ 3# lovenice831


¼Ó¤WªþÀɤ¤´N¦³§R°£¤U©Ô²M³æ«ü¥O~~

TOP

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


    ÁÂÁ¤j¤j ¡A¤Q¤À·PÁÂ

TOP

        ÀR«ä¦Û¦b : ¬°¤H³B¥@­n¤p¤ß²Ó¤ß¡A¦ý¤£­n¡u¤p¤ß²´¡v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD