[µo°Ý] ¨Ì±ø¥ó¦X¨Ö¸ê®Æ

jesscc

¥H SÄæ ¸ê®Æ§@¬°§PÂ_¡A¬Û¦P¸ê®Æ¶W¹L¤@µ§¥H¤W´N±N¨ä¹ïÀ³ªº D¦C ¸ê®Æµ²¦X¡A¦pªG SÄæ ¤¤¥u¦³¤@µ§ªº¡A´Nª½±µ¶ñ¤J DÄæ ªº¬ÛÃö¸ê®Æ¡Cªþ¥ó¤º¦³¸Ô²Ó»¡©ú
¥u¼g¤F¤@³¡¤À¡A¦ý°õ¦æ¤£¦p¹w´Á¡A¤£ª¾­þ¸Ì¿ù¤F¡AÁٽбоɡC
test.rar (23.11 KB)

¤U¸ü¦¸¼Æ: 3

2019-6-29 11:03

­ã´£³¡ªL

Sub test()
Dim Arr, Brr, xD, R&, i&, N&, T$, TY$, TR
Sheets("INVOICE").UsedRange.Offset(7, 0).EntireRow.Delete
Set xD = CreateObject("scripting.dictionary")
R = Sheets("B area").[G5000].End(xlUp).Row
Arr = Sheets("B area").Range("A7:X" & R)
ReDim Brr(1 To R, 1 To 9)
For i = 1 To UBound(Arr)
    T = Arr(i, 19):   R = xD(T):   If T = "" Then GoTo 101
    TY = Arr(i, 14) & "*" & Format(Arr(i, 7), "#,##0") & "pcs"  '®Æ¸¹*¥X³f¼Æ ¤å¦r¦ê, ¥i±N*§ï¬°ªÅ®æ
    If R = 0 Then
       N = N + 1: xD(T) = N: R = N
       Brr(N, 1) = N '§Ç¸¹
       Brr(N, 2) = "PKG"
       Brr(N, 3) = Arr(i, 17) '¥ó¼Æ
       Brr(N, 6) = Arr(i, 22) / Arr(i, 17) 'Unit Price (US$)
       Brr(N, 7) = Arr(i, 22) 'Amount (US$)
    End If
    Brr(R, 5) = Val(Brr(R, 5)) + Val(Arr(i, 7)) '¥X³f¼Æ(²Ö­p)
    Brr(R, 8) = Val(Brr(R, 8)) + Val(Arr(i, 8)) '²b­«(²Ö­p)
    Brr(R, 9) = Val(Brr(R, 9)) + Val(Arr(i, 9)) '¤ò­«(²Ö­p)
    '------------------------------------
    T = Replace(Replace(Brr(R, 4), "//", "("), ")", "") '¨ú±o­ì¤ÀÃþ¤å¦r
    If T = "" Then Brr(R, 4) = Arr(i, 14) & "//" & TY: GoTo 101
    TR = Split(T, "(")  '©î¸Ñ­ì¤ÀÃþ¤å¦r
    Brr(R, 4) = Trim(TR(0)) & " ( " & Trim(TR(1)) & ", " & TY & " )" '¤ÀÃþ(¥[µù)
101: Next i
If N = 0 Then Exit Sub
With Sheets("INVOICE").[C8].Resize(N, 9)
     .Value = Brr
     .Columns(4).Replace "//*", "", Lookat:=xlPart '­Y¬°³æµ§, ²M°£«á­±ªº¥[µù¤å¦r
     .Columns(4).WrapText = True '¦Û°Ê´«¦C
     .Columns(4).EntireRow.AutoFit '¦Û°Ê¦C°ª
     .Borders.LineStyle = 1  '®Ø½u
     Application.Goto .Item(1) '¸õ¦ÜINVOICE¤u§@ªí
End With
End Sub

test_v1.rar (29.79 KB)

¤U¸ü¦¸¼Æ: 11

2019-6-30 11:22

============================

jesscc

·PÁ­ã¤j¡A¤@©wªá¤F«Ü¦h®É¶¡¡Cµ{¦¡½X«Ü²`¶ø¡A¦ý¬O§Ú·Q­n¹F¨ìªº®ÄªG¨ä¹ê«Ü³æ¯Â:
¤u§@ªí"B area" ­nÂà¨ì ¤u§@ªí"INVOICE" ªº¸ê®Æ¬O:
QÄæ(¥ó¼Æ)-->¤u§@ªí"INVOICE" EÄæ
NÄæ(¤ÀÃþ) & ( DÄæ(P/N ®Æ¸¹) & GÄæ(¥X³f¼Æ) & PCS¡A..... )-->¤u§@ªí"INVOICE" FÄæ(¨Ì·Ó ¤u§@ªí"B area" SÄæ¬Û¦Pªº¸ê®Æ(¤w¥Î©³¦â¼Ð¥Ü)±N¦UÄæ¦ì¸ê®Æµ²¦X¬°¤@¦ê¤å¦r¡A¦b¾ã¦êµ²¦X¦nªº¤å¦r«e¥[¤WNÄæ(¤ÀÃþ))
VÄæ(Amount (US$))-->¤u§@ªí"INVOICE" IÄæ
VÄæ(Amount (US$)) / QÄæ(¥ó¼Æ)-->¤u§@ªí"INVOICE" HÄæ

¥H¤W¸ê®Æ±q ¤u§@ªí"INVOICE" ¤w¦s¦bªº³Ì«á¤@µ§¸ê®Æ¡A¤]´N¬O27¦C±µÄò©¹¤U¶ñ¤J
¤§«eÁÙ¦³µ²¦X¦r¦ê¥ª¥k¥[¬A¸¹¡B¥[³rÂIªº°ÝÃD¡A¦ý¤w¸Ñ¨M¡C²{¦bªº¥D­n°ÝÃD¬Oµ²¦X¥X¨Óªº ¤u§@ªí"INVOICE" FÄæ ¸ê®Æ¤£¥¿½T¡A¨ä¥L¸ê®Æ³£¥¿½T¡A¤£¥ÎÅÜ°Ê¡C

¤U¸ü (237.3 KB)

2019-6-30 13:49

­ã´£³¡ªL

¦^´_ 3# jesscc

Sub test()
Dim Arr, Brr, xD, R&, i&, N&, T$, TY$, TR, xE As Range
Set xD = CreateObject("scripting.dictionary")
R = Sheets("B area").[G5000].End(xlUp).Row
Arr = Sheets("B area").Range("A7:X" & R)
ReDim Brr(1 To R, 1 To 9)
For i = 1 To UBound(Arr)
    T = Arr(i, 19):   R = xD(T):   If T = "" Then GoTo 101
    TY = Arr(i, 14) & "*" & Format(Arr(i, 7), "#,##0") & "pcs"  '®Æ¸¹*¥X³f¼Æ ¤å¦r¦ê, ¥i±N*§ï¬°ªÅ®æ
    If R = 0 Then
       N = N + 1: xD(T) = N: R = N
       'Brr(N, 1) = N '§Ç¸¹
       Brr(N, 2) = "PKG"
       Brr(N, 3) = Arr(i, 17) '¥ó¼Æ
       Brr(N, 6) = Arr(i, 22) / Arr(i, 17) 'Unit Price (US$)
       Brr(N, 7) = Arr(i, 22) 'Amount (US$)
    End If
    'Brr(R, 5) = Val(Brr(R, 5)) + Val(Arr(i, 7)) '¥X³f¼Æ(²Ö­p)
    'Brr(R, 8) = Val(Brr(R, 8)) + Val(Arr(i, 8)) '²b­«(²Ö­p)
    'Brr(R, 9) = Val(Brr(R, 9)) + Val(Arr(i, 9)) '¤ò­«(²Ö­p)
    '------------------------------------
    T = Replace(Replace(Brr(R, 4), "//", "("), ")", "") '¨ú±o­ì¤ÀÃþ¤å¦r
    If T = "" Then Brr(R, 4) = Arr(i, 14) & "//" & TY: GoTo 101
    TR = Split(T, "(")  '©î¸Ñ­ì¤ÀÃþ¤å¦r
    Brr(R, 4) = Trim(TR(0)) & " ( " & Trim(TR(1)) & ", " & TY & " )" '¤ÀÃþ(¥[µù)
101: Next i
If N = 0 Then Exit Sub
Set xE = Sheets("INVOICE").[D65536].End(xlUp)(2, 0)
With xE.Resize(N, 9)
     .Value = Brr
     .Columns(4).Replace "//*", "", Lookat:=xlPart '­Y¬°³æµ§, ²M°£«á­±ªº¥[µù¤å¦r
     .Columns(4).WrapText = True '¦Û°Ê´«¦C
     .Columns(4).EntireRow.AutoFit '¦Û°Ê¦C°ª
     .Borders.LineStyle = 1  '®Ø½u
     Application.Goto .Item(1) '¸õ¦ÜINVOICE¤u§@ªí
End With
End Sub


========================

jesscc

­ã¤j¡A±zªºµ{¦¡¹ï§Úªºµ{«×¨Ó»¡¹ê¦b¤Ó²`¶ø¤F¡A¤×¨ä¬O³B²z¤ÀÃþ¦r¦ê¨º³¡¤À¡A´X¥G§¹¥þ¬Ý¤£À´¡C
§Ú¦b½×¾Â¸Ì§ä¨ì¤@­Ó½d¨Ò¡A»P§Ú·Q­nªºµ²ªGÁÙº¡±µªñªº¡A­×§ï¤F¤@¤U¡A¥Ø«e¬Ý¨Ó¥i¥Î¡A¦ý´N¬O¥u¯àµ²¦X¦r¦ê(¦r¦ê³Ì¥kÃä·|¯Ê¤@­Ó¥k¬A¸¹)¡A¨S¿ìªkÂà¦UÄæ¦ìªº¼Æ­È¡A¯àÀ°§Ú¬Ý¬Ý¥[¤WÂà¦UÄæ¦ìªº¼Æ­È¶Ü?

1. Sub new1()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. 
   
4. For Each s In Range([S7], [S3000].End(xlUp))
   
5.    If d(s.Value) = "" Then '¦pªGKÄæ¸ê®Æ¥u¦³¤@µ§¤£­«½Æ
   
6.       d(s.Value) = s.Offset(, -5) & " " & "( " & s.Offset(, -15) & "  " & s.Offset(, -12) & " PCS"
   
7.       Else
   
8.       d(s.Value) = d(s.Value) & ", " & s.Offset(, -15) & "  " & s.Offset(, -12) & " PCS"
   
9.     End If
   
10. Next
    
11. 
    
12. With Sheets("INVOICE")
    
13.     xrow = .[F3000].End(xlUp).Row
    
14.     .[B3] = xrow
    
15.     .Range("C" & xrow + 1, "K3000").ClearContents
    
16.     .Range("F" & xrow).Offset(1, 0).Resize(d.Count, 1) = Application.Transpose(d.items)
    
17. End With
    
18. Set d=Nothing
    
19. End Sub

½Æ»s¥N½X