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

´M§ä¦³¨S¦³¬Û¦P¼Æ¾ÚªºÄæ¦ì

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


­ã¤j¡A§Ú¥´¶}ùØ­±µ{¦¡·Q¾Ç²ß¤Î°µ·L½Õ¡A¦ý¬OùØ­±ª`ÄÀ¬O¶Ã½X¡A¥i§_±Nµ{¦¡¶K¦b¦^´_¤W¡A¤è«K§Ú¾Ç²ß¡AÁÂÁ¡I

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2024-2-29 10:55 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ ­ã´£³¡ªL«e½ú«ü¾É,ÁÂÁ«e½úµo¸ÜÃD¤@°_¾Ç²ß
«Øij«e½ú¦b±o¨ì¨ó§U¥N½X«á¸ÕµÛ¦Û¤v³v¦C¤F¸Ñ¨ä·N¸q,¥²­n®É¦Û¤vµù¸Ñ,¤£¤F¸Ñªº³¡¤À¬d½×¾Â,©Î¥¦ºô,©Î°Ý¥N½X²Ó¸`
¥H¤U¬O ­ã´£³¡ªL«e½úªº¤è®×

Sub Test_A1()
Dim Arr, Brr, xD, xZ As Range, xF As Range, T$, R&, C&, i&
T = [Invoice!G5] '³æ¸¹
If Not T Like "INV########" Then Exit Sub '³æ¸¹¤£²Å¦XINV+8¦ì¤é´Á..¸õ¥X
Set xZ = [Data!a1].Cells(1, Columns.Count).End(1)  '§ädata²Ä¤@¦æ³Ì«á«DªÅ
Set xF = [Data!1:1].Find(T, Lookat:=xlWhole) '§ä³æ¸¹¦bdataªºÄæ¦ì
If xF Is Nothing Then Set xZ = xZ(1, 2): Set xF = xZ '­Y³æ¸¹¤£¦s¦b, ¼W¥[¤@Äæ
Set xD = CreateObject("Scripting.Dictionary")
'-------------------------------
Arr = Range([Data!c1], [Data!a1].Cells(Rows.Count, 1).End(3))
Arr(1, 1) = T '±NArr²Ä¤@Äæ­º®æ©ñ¤J"³æ¸¹"
For i = 2 To UBound(Arr)
    T = Arr(i, 1) & "\" & Arr(i, 2) & "\" & Arr(i, 3)
    xD(T) = i '¦r¨å°O¾Ð¦æ¦ì¸m
    Arr(i, 1) = 0  '±NArr²Ä¤@Äæ©ñ¤J0, ¥H³Æ¶ñ¤J¼Æ¶q
Next i
'----------------------------
Brr = Range([Invoice!h1], [Invoice!a1].Cells(Rows.Count, 1).End(3))
For i = 2 To UBound(Brr)
    R = xD(Brr(i, 3) & "\" & Brr(i, 4) & "\" & Brr(i, 5))
    If R > 0 Then Arr(R, 1) = Arr(R, 1) + Brr(i, 6)
Next i
'----------------------------
xF.Resize(UBound(Arr)).Value = Arr
With Range([Data!F1], xZ).Resize(UBound(Arr)) '³æ¸¹Äæ®æ¦¡
     .ColumnWidth = 15 '²Î¤@Äæ¼e
     .Borders.LineStyle = 1 '¥[®Ø
     .HorizontalAlignment = xlCenter 'Áa¸m¤¤
     .VerticalAlignment = xlCenter   '¾î¸m¤¤
End With
[Data!e2].Resize(UBound(Arr) - 1) = "=D2-SUM(F2:" & xZ(2).Address(0, 0) & ")" 'EÄæ"µ²¾l"¤½¦¡(ÀHÄæ¼ÆÅܤÆ)..§R¥hÄæ¤]¥i¥¿½T­pºâ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 12# Andy2483


­ì¥»¬OKH ªº¼Æ¶qcopy ¨ìData ªºÄæD, ¦pªG·Q±NÄæD §ï爲ÄæE¡A ³o­ÓÀ³¸Ó¦b­þ¥y­×§ï¡H

TOP

¦^´_ 13# 198188

§ä¨ì¤èªk¤F

    Sub Test_A1()
Dim Arr, Brr, xD, xZ As Range, xF As Range, T$, R&, C&, i&, A, B

A = Worksheets("Data").Range("A1").End(xlDown).Row
For B = 2 To A
Worksheets("Data").Cells(B, 4) = Worksheets("Data").Cells(B, 5)
Next B

T = [data!E1] 'invoice no
Set xZ = [Data!a1].Cells(1, Columns.Count).End(1)  'Find Data last column
Set xF = [Data!1:1].Find(T, Lookat:=xlWhole) 'Find invoice no from Data all column?
If xF Is Nothing Then Set xZ = xZ(1, 2): Set xF = xZ 'if don't find, add one column


Set xD = CreateObject("Scripting.Dictionary")
'-------------------------------
Arr = Range([Data!c1], [Data!a1].Cells(Rows.Count, 1).End(3))
Arr(1, 1) = T 'put Arr first column on invoice
For i = 2 To UBound(Arr)
    T = Arr(i, 1) & "\" & Arr(i, 2) & "\" & Arr(i, 3)
    xD(T) = i 'record column place
    Arr(i, 1) = 0  'set Arr first column 0,for back up to input?
Next i
'----------------------------
Brr = Range([KH!E1], [KH!a1].Cells(Rows.Count, 1).End(3))
For i = 2 To UBound(Brr)
    R = xD(Brr(i, 2) & "\" & Brr(i, 3) & "\" & Brr(i, 4))
    If R > 0 Then Arr(R, 1) = Arr(R, 1) + Brr(i, 5)
Next i
'----------------------------
xF.Resize(UBound(Arr)).Value = Arr

[Data!F2].Resize(UBound(Arr) - 1) = "=E2-SUM(G2:" & xZ(2).Address(0, 0) & ")" 'Column E BAL.
'RESET AND DELETE OLD RECORD
End Sub

TOP

¦^´_ 13# 198188


    ³o¸ÜÃD½d¨Ò¨S¦³³o»Ý¨D,«Øij¥t¤W¶Ç·s½d¨Ò,¸Ì­±©ñ¨â­Óµ²ªGªí(°õ¦æ«eªí,°õ¦æµ²ªGªí),
³o¼Ëªº½d¨ÒÅý¨ó§UªÌ¤ñ¸û¨â­Óµ²ªGªíªº®t²§,«Ü®e©öª¾¹D»Ý¨D¬O¤°»ò
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 15# Andy2483


   ¦]爲§Ú­×§ï¤F¤@¨Ç®æ¦¡¡A©Ò¥H»Ý­n¦A·L½Õµ{¦¡¡C
ªþ¥ó¤W§Ú°ò©ó¤@¨Ç¹ê»Ú§ïÅܦӰµ¤F¤@¨Ç§ï°Ê¡Aµ{¦¡¤]·L½Õ¤F¡C

account.rar (188.11 KB)

TOP

        ÀR«ä¦Û¦b : ¯¸¦b¥b¸ô¡A¤ñ¨«¨ì¥Ø¼Ð§ó¨¯­W¡C
ªð¦^¦Cªí ¤W¤@¥DÃD