- ©«¤l
- 406
- ¥DÃD
- 8
- ºëµØ
- 0
- ¿n¤À
- 453
- ÂI¦W
- 0
- §@·~¨t²Î
- WINDOWS 7
- ³nÅ骩¥»
- 2007
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2015-2-7
- ³Ì«áµn¿ý
- 2021-7-31
|
¥»©«³Ì«á¥Ñ n7822123 ©ó 2021-1-5 03:06 ½s¿è
¦^´_ 17# n7822123
µo²{§Úªºµ{¦¡Bug¡A·í¸Ó³ø§i½s¸¹ªº¸ê®Æè¦n¥u¦³¤@µ§®É¡A·|¦³°ÝÃD(°}¦CÂà¸m·|Åܦ¨1ºû°}¦C)
קï¦p¤Uµ{¦¡¡A³o¦¸À³¸Ó¥i¥Hº¡¨¬§Aªº»Ý¨D~ ¥\¯à¦p¤U
ÂI¿ï ³ø§i¶ªº J6 Àx¦s®æ ¡A·|¦Û°Ê¨Ì Data¶ ªº "Receiving Report No" ²£¥Í¤U©Ô¦¡¿ï³æ
¿ï¾Ü¦n "Reference No" (J6)«á¡A·|¦Û°Ê²£¥Í³ø§i(¥t°µ·s¤u§@ªí¡A¤£§ï½d¥»®æ¦¡¡AÁקK«½Æ°õ¦æ·|¦³°ÝÃD)
IJµo¨Æ¥ó-¦Û°ÊIJµoµ{¦¡¡A½Ð½Æ»s¶K¤W¨ì "Receiving Report" ¤u§@ªí¸Ì±
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row = 6 And Target.Column = 10 Then
Application.EnableEvents = False
Call ³]¤U©Ô¿ï³æ
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 6 And Target.Column = 10 Then
Application.EnableEvents = False
Call ¦¬³f³øªí_³æ¿ï
Application.EnableEvents = True
End If
End Sub
¤@¯ë¼Ò²Õµ{¦¡¡A½ÐÀH«K³Ð¤@Ó¼Ò²Õ¶K¤Wµ{¦¡§Y¥i
Dim Arr, RepNo$
Sub ³]¤U©Ô¿ï³æ()
Application.ScreenUpdating = False
On Error GoTo «ì´_
Set D = CreateObject("Scripting.Dictionary")
Arr = ['Receiving DATA'!A4].CurrentRegion
For R = 2 To UBound(Arr)
RepNo = Arr(R, 13)
If D(RepNo) = 0 Then D(RepNo) = R
Next R
For Each Key In D.keys: §å¸¹¦ê = §å¸¹¦ê & "," & Key: Next Key
With ['Receiving Report'!J6].Validation
.Delete
.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=§å¸¹¦ê
End With
Exit Sub
«ì´_: ¶}±ÒIJµo¨Æ¥ó
End Sub
Sub ¦¬³f³øªí_³æ¿ï()
Dim Brr(), R0%, R&, K%, D As Object
Application.ScreenUpdating = False
On Error GoTo «ì´_
RepNo = ['Receiving Report'!J6]
If RepNo = "" Then Exit Sub
Set D = CreateObject("Scripting.Dictionary")
Arr = ['Receiving DATA'!A4].CurrentRegion
For R = 2 To UBound(Arr)
If D(Arr(R, 13) & "") = 0 Then D(Arr(R, 13) & "") = R
Next R
R0 = D(RepNo): ·sªí R0
For R = R0 To UBound(Arr)
K = K + 1: ReDim Preserve Brr(1 To 11, 1 To K)
Brr(1, K) = Arr(R, 9) '³fª«¦WºÙ
Brr(3, K) = Arr(R, 5) '§å¸¹
Brr(4, K) = Arr(R, 7) 'ªO¸¹
Brr(5, K) = Arr(R, 8) '½c¸¹
Brr(8, K) = Arr(R, 10) '¹êª«¦¬³f
If R + 1 > UBound(Arr) Then ¥t¦s·sÀÉ Brr: Exit For
If Arr(R + 1, 13) <> RepNo Then ¥t¦s·sÀÉ Brr: Exit For
Next R: Erase Arr: Erase Brr
Exit Sub
«ì´_: ¶}±ÒIJµo¨Æ¥ó
End Sub
Sub ¦¬³f³øªí_§å¦¸()
Dim Brr(), R&, K%
Application.ScreenUpdating = False
Arr = ['Receiving DATA'!A4].CurrentRegion
For R = 2 To UBound(Arr)
If Arr(R, 13) <> RepNo Then ·sªí R: RepNo = Arr(R, 13): K = 0
K = K + 1: ReDim Preserve Brr(1 To 11, 1 To K)
Brr(1, K) = Arr(R, 9) '³fª«¦WºÙ
Brr(3, K) = LotNo '§å¸¹
Brr(4, K) = Arr(R, 7) 'ªO¸¹
Brr(5, K) = Arr(R, 8) '½c¸¹
Brr(8, K) = Arr(R, 10) '¹êª«¦¬³f
If R + 1 > UBound(Arr) Then ¥t¦s·sÀÉ Brr: Exit For
If Arr(R + 1, 13) <> RepNo Then ¥t¦s·sÀÉ Brr
Next R: Erase Arr: Erase Brr
Sheets("Receiving DATA").Activate
End Sub
Sub ·sªí(ByVal R)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Receiving Report").Copy After:=Sheets(Sheets.Count)
On Error Resume Next
Sheets("Reference No " & Arr(R, 13)).Delete
On Error GoTo 0
ActiveSheet.Name = "Reference No " & Arr(R, 13)
[C10] = Int(Arr(R, 2)) '¦¬³f¤é´Á
[F10] = Arr(R, 2) - [C10] '¦¬³f®É¶¡
[C11] = Arr(R, 3) 'Âd¸¹/³f¨®¨®µP
[J6] = Arr(R, 13) 'Reference No:
[J8] = Arr(R, 5) 'Lot Number
[J10] = Arr(R, 11) 'PO No.
[J11] = Arr(R, 14) 'BD t³d¤H
[G11] = Arr(R, 4) '«Ê±ø¸¹
§R°£·sªíIJµo¨Æ¥ó ActiveSheet.CodeName
[J6].Validation.Delete
End Sub
Sub ¥t¦s·sÀÉ(ByVal Brr)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
MyPath = ThisWorkbook.Path & "\"
Brr = Application.Transpose(Brr) '·íBrr¸ê®Æ¥u¦³¤@µ§¡AÂà¸m«áÅÜ1ºû°}¦C
Rn = UBound(Brr): [G13] = Rn
On Error Resume Next
XX% = UBound(Brr, 2) '·íBrr=1ºû°}¦C¡A·|¸õ¿ù»~
If Err <> 0 Then Rn = 1 '¿ù»~®É¡A³]Rn=1
On Error GoTo 0
If Rn >= 4 Then
Rows("21:" & 21 + Rn - 4).Insert Shift:=4
Rows(20).Copy
Rows("21:" & 21 + Rn - 4).Select
ActiveSheet.Paste
End If: [A10].Select
Application.CutCopyMode = False
[A19].Resize(Rn, 11) = Brr
[H13] = WorksheetFunction.Sum([E19].Resize(Rn))
ActiveSheet.Copy
With ActiveSheet
.Parent.SaveAs MyPath & .Name & ".xls", xlNormal
.Parent.Close 1
End With
'ActiveSheet.Delete
End Sub
Sub §R°£·sªíIJµo¨Æ¥ó(ByVal ·sªíCodeNm)
Application.DisplayAlerts = False
With ThisWorkbook.VBProject
For Each vbx In .VBComponents
If vbx.Name = ·sªíCodeNm Then
With vbx.CodeModule: .DeleteLines 1, .CountOfLines: End With
End If
Next
End With
End Sub
Sub ¶}±ÒIJµo¨Æ¥ó()
Application.EnableEvents = True
End Sub
Àɮצp¤U
test Receiving Data 2021-0105.rar (55.67 KB)
|
|