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

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

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

¥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)
Jess

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)


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

TOP

·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
¥¼©R¦W-1.png
2019-6-30 13:49
Jess

TOP

¦^´_ 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


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

TOP

­ã¤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. For Each s In Range([S7], [S3000].End(xlUp))
  4.    If d(s.Value) = "" Then '¦pªGKÄæ¸ê®Æ¥u¦³¤@µ§¤£­«½Æ
  5.       d(s.Value) = s.Offset(, -5) & " " & "( " & s.Offset(, -15) & "  " & s.Offset(, -12) & " PCS"
  6.       Else
  7.       d(s.Value) = d(s.Value) & ", " & s.Offset(, -15) & "  " & s.Offset(, -12) & " PCS"
  8.     End If
  9. Next

  10. With Sheets("INVOICE")
  11.     xrow = .[F3000].End(xlUp).Row
  12.     .[B3] = xrow
  13.     .Range("C" & xrow + 1, "K3000").ClearContents
  14.     .Range("F" & xrow).Offset(1, 0).Resize(d.Count, 1) = Application.Transpose(d.items)
  15. End With
  16. Set d=Nothing
  17. End Sub
½Æ»s¥N½X
Jess

TOP

        ÀR«ä¦Û¦b : ¤H­n¦Û·R¡A¤~¯à·R´¶¤Ñ¤Uªº¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD