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

[µo°Ý] ¨âªí¸ê®Æ­«½Æ¹ï¤ñ¨Ã¼Æ¶q¬Û­¼

[µo°Ý] ¨âªí¸ê®Æ­«½Æ¹ï¤ñ¨Ã¼Æ¶q¬Û­¼



¦³¨â­Óªí Read & Data

Data ¬O¸ê®ÆÀÉ®×
Read ¬Oµ{¦¡°õ¦æÀÉ®×


°õ¦æµ{¦¡³W«h¡G
Read ªí ¦Ç¦â³¡¤À¬O­ì¦³¸ê®Æ¡A«O¯d¡C
Read ªí A Äæ  ¹ï¤ñ Data ªí H Äæ¡A
­Y§k¦X¡A½Æ»s Data ªí ¹ïÀ³ªº¤@¦C¸ê®Æ¨ì Read ªí A Äæ³Ì«á¤@¦C«á, ¼Æ¶q Read ªí  Qty * Data ªí Qty ¡]¦pÂŦⳡ¤À¡^
§¹¦¨«á¡A¦A­«½Æ¤@¦¸
Read ªí A Äæ  ¹ï¤ñ Data ªí H Äæ¡A
­Y§k¦X¡A½Æ»s Data ªí ¹ïÀ³ªº¤@¦C¸ê®Æ¨ì Read ªí A Äæ³Ì«á¤@¦C«á, ¼Æ¶q Read ªí  Qty * Data ªí Qty ¡]¦pºñ¦â¦â³¡¤À¡^

¦^´_  198188


    ½Ð«e½ú¤W¶Ç½d¨ÒÀÉ
Andy2483 µoªí©ó 2025-11-6 11:10


«e½ú¡Aªþ¤W½d¨Ò

½d¨Ò.rar (10.69 KB)

TOP

  1. Option Explicit
  2. Sub TEST()
  3. Dim arr, Brr, Z, K, i&, j%, N&
  4. Set Z = CreateObject("Scripting.Dictionary")
  5. Brr = [Read!A1].CurrentRegion
  6. For i = 2 To UBound(Brr): Z(Brr(i, 1)) = Val(Brr(i, 3)): Next
  7. Brr = Range([Data!A1], [Data!A1].CurrentRegion.Offset(UBound(Brr)))
  8. For i = 2 To UBound(Brr)
  9.    If Z.Exists(Brr(i, 8)) Then
  10.       Z(Brr(i, 1) & "/") = i
  11.       Brr(i, 3) = Z(Brr(i, 8)) * Val(Brr(i, 3))
  12.    End If
  13.    If Z.Exists(Brr(i, 8) & "/") Then
  14.       Z(Brr(i, 8) & "//") = i
  15.       Brr(i, 3) = Brr(Z(Brr(i, 8) & "/"), 3) * Val(Brr(i, 3))
  16.    End If
  17. Next
  18. For Each K In Z.Keys
  19.    If InStr(K, "/") Then
  20.       N = N + 1
  21.       For j = 1 To UBound(Brr, 2): Brr(N, j) = Brr(Z(K), j): Next
  22.       'Brr(N, 3) = "=" & Brr(N, 3)
  23.    End If
  24. Next
  25. arr = Sheets("Read").UsedRange
  26. Sheets("Read").Range("A" & UBound(arr) + 1).Resize(N, UBound(Brr, 2)) = Brr
  27. End Sub
½Æ»s¥N½X
¦^´_  198188


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò,«á¾Ç¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub  ...
Andy2483 µoªí©ó 2025-11-6 14:16


«e½ú§Ú­×§ï¦p¤W¡C

TOP

¦^´_  198188


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò,«á¾Ç¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub  ...
Andy2483 µoªí©ó 2025-11-6 14:16


Brr = Range([Data!A1], [Data!A1].CurrentRegion.Offset(UBound(Brr)))

½Ð°Ý«e½ú¡A³o¥y¦pªG·Q§ï
xFile = "Data Base.xlsx"
sheets ("Data")
À³¸Ó¦p¦ó®M¤J¡H

TOP

With Workbooks("Data Base.xlsx").Sheets("Data")
   Brr = .Range(.[A1], .[A1].CurrentRegion.Of ...
Andy2483 µoªí©ó 2025-11-6 15:38



«e½ú¡A¦pªG¼Æ¶q¨C¤@½üªº¼Æ¶q³£¥Î  «e¤@½üªºÁ`¼Æ¶q *  Data Base ªº¼Æ¶q¡AÀ³¸Ó¦p¦ó§ó§ï¡H
Á|¨Ò
¥»ÀɦǦâ¬O­ì¥»¼Æ¶q¡A
E1204 ¦@¦³6­Ó

²Ä¤@½ü¹B¦æ
E1204 ¦@¦³6­Ó
E1204 ¹ïÀ³ A1122
A1122 ¦³ 2 ¦æ, ¦p¤U
A1122  2 * 6 =12
A1122  3 * 6 =18

²Ä¤G½ü¹B¦æ
A1122 ¦@¦³30­Ó

A1122 ¹ïÀ³ B1236
B1236 ¦³ 1 ¦æ, ¦p¤U
B1236    2 * 30 = 60

½d¨Ò.rar (12.52 KB)

TOP

¦^´_  198188


    ½Ð«e½ú¦Û¦æ¸Õ¸Õ¼g¤@¬q¥N½X¥ý§âData ¦P¸¹¬Û¥[¡A¦A±NRead¤ñ¹ï2¦¸Data
Andy2483 µoªí©ó 2025-11-6 19:04
  1. Brr = [Read!A1].CurrentRegion
  2. For i = 2 To UBound(Brr): Z(Brr(i, 1)) = Val(Brr(i, 3)): Next
  3. N = 1
  4. For i = 2 To UBound(Brr)
  5.    If Z.Exists(Brr(i, 1)) Then
  6.           Z(Brr(N, 3)) = Z(Brr(N, 3)) + Brr(i, 3)
  7.       End If
  8. Next
½Æ»s¥N½X
§Ú¹Á¸Õ±N¦Ç¦âªº¼Æ¶q°O¤J¦r¨å¡AÀY¥|­Ó¦¨¥\°O¤J¡A¦ý¬O«á­±¤£À´±o¥[Á`¡A

TOP

¥»©«³Ì«á¥Ñ 198188 ©ó 2025-11-7 12:02 ½s¿è
¦^´_  198188


    ½Ð«e½ú¦Û¦æ¸Õ¸Õ¼g¤@¬q¥N½X¥ý§âData ¦P¸¹¬Û¥[¡A¦A±NRead¤ñ¹ï2¦¸Data
Andy2483 µoªí©ó 2025-11-6 19:04



  «e½ú¡A²Ä¤@¨B ±NRead ªíªº CODE ©ñ¤J¦r¨å¡AQty ¤]©ñ¤J¦r¨å¨Ã¬Û¦P Code ¥[Á`¡A³o³¡¤À§Ú¸Õ¤F«Ü¦h¦¸¡A³£¤£¦¨¥\¡C
½Ð«üÂI¤@¤U«á¾Ç¡C

TOP

¥»©«³Ì«á¥Ñ 198188 ©ó 2025-11-7 14:55 ½s¿è
  1. Sub sumdata()
  2. Dim i As Long
  3. Dim n As Long
  4. Dim ar, arr, brr As Variant
  5. Dim dict As New Dictionary

  6. ar = [A1].CurrentRegion
  7. Set dict = CreateObject("Scripting.Dictionary")

  8. With dict
  9. For i = 1 To UBound(ar, 1)
  10. .Item(ar(i, 1)) = .Item(ar(i, 1)) + ar(i, 3)
  11. Next i
  12. arr = Array(.Keys, .Items)
  13. n = .Count
  14. End With

  15. [O1].Resize(n, 2).Value = Application.Transpose(arr)


  16. brr = Sheets("Data").UsedRange
  17. For i = 2 To UBound(brr)
  18.    If dict(brr(i, 8)) > 0 Then
  19.       m = m + 1
  20.       For j = 1 To 13: brr(m, j) = brr(i, j): Next
  21.       brr(m, 3) = brr(m, 3) * dict(brr(i, 8))
  22.          
  23.    End If
  24. Next
  25. If m > 0 Then Sheets("Read").[A13].Resize(m, 13) = brr: m = 0 Else MsgBox "Frame per Dwg_Nothing"

  26. End Sub
½Æ»s¥N½X
¦^´_  198188


    ½Ð«e½ú¦Û¦æ¸Õ¸Õ¼g¤@¬q¥N½X¥ý§âData ¦P¸¹¬Û¥[¡A¦A±NRead¤ñ¹ï2¦¸Data
Andy2483 µoªí©ó 2025-11-6 19:04


«e½ú¡A§Ú§¹¦¨²Ä¤@½ü¤F¡C

TOP

¦^´_  198188


    ½Ð«e½ú¦Û¦æ¸Õ¸Õ¼g¤@¬q¥N½X¥ý§âData ¦P¸¹¬Û¥[¡A¦A±NRead¤ñ¹ï2¦¸Data
Andy2483 µoªí©ó 2025-11-6 19:04
  1. Sub sumdata()
  2. Dim i As Long
  3. Dim n As Long
  4. Dim ar, arr, brr As Variant
  5. Dim dict As New Dictionary
  6. .Column("O:P").Delete
  7. ar = [A1].CurrentRegion
  8. lastRow = UBound(ar)
  9. Set dict = CreateObject("Scripting.Dictionary")

  10. With dict
  11. For i = 1 To UBound(ar, 1)
  12. .Item(ar(i, 1)) = .Item(ar(i, 1)) + ar(i, 3)
  13. Next i
  14. arr = Array(.Keys, .Items)
  15. n = .Count
  16. End With
  17. [O1].Resize(n, 2).Value = Application.Transpose(arr)

  18. brr = Sheets("Data").UsedRange
  19. For i = 2 To UBound(brr)
  20.    If dict(brr(i, 8)) > 0 Then
  21.       m = m + 1
  22.       For j = 1 To 13: brr(m, j) = brr(i, j): Next
  23.       brr(m, 3) = brr(m, 3) * dict(brr(i, 8))
  24.    
  25.    End If
  26. Next
  27. If m > 0 Then Sheets("Read").Range("A" & lastRow + 1).Resize(m, 13) = brr: m = 0

  28. ar = Range("A" & lastRow + 1).CurrentRegion
  29. lastRow1 = UBound(ar)
  30. ar = Range("A" & lastRow & ":M" & lastRow1)
  31. Set dict = CreateObject("Scripting.Dictionary")

  32. With dict
  33. For i = 2 To UBound(ar, 1)
  34. .Item(ar(i, 1)) = .Item(ar(i, 1)) + ar(i, 3)
  35. Next i
  36. arr = Array(.Keys, .Items)
  37. n = .Count
  38. End With
  39. [O1].Resize(n, 2).Value = Application.Transpose(arr)

  40. brr = Sheets("Data").UsedRange
  41. For i = 1 To UBound(brr)
  42.    If dict(brr(i, 8)) > 0 Then
  43.       m = m + 1
  44.       For j = 1 To 13: brr(m, j) = brr(i, j): Next
  45.       brr(m, 3) = brr(m, 3) * dict(brr(i, 8))
  46.    
  47.    End If
  48. Next
  49. If m > 0 Then Sheets("Read").Range("A" & lastRow1 + 1).Resize(m, 13) = brr: m = 0

  50. End Sub
½Æ»s¥N½X
«e½ú¡A¤w¸g§¹¦¨¡A½Ð«üÂI¡C

TOP

¥»©«³Ì«á¥Ñ 198188 ©ó 2025-11-7 17:44 ½s¿è
¦^´_  198188


    ÁÂÁ«e½ú«ü¾É,«Ü¦h¨S¬Ý¹Lªº,«á¾Ç°õ¦æ¥X²{°»¿ù,½Ð«e½ú«üÂI
Andy2483 µoªí©ó 2025-11-7 16:40



   

«e½ú¡A»Ý­n¥h ¤u¨ã =>³]©w¤Þ¥Î¶µ¥Ø => Microsoft Scripting Runtime
ªþ¤W½d¨Ò

½d¨Ò.rar (12.52 KB)

TOP

        ÀR«ä¦Û¦b : ¡i®É¶¡µLªk¾B¾×¡j©È®É¶¡®ø³u¡Aªá¤F³\¦h¤ß¦å¡A·QºÉ¦U¦¡¤èªk­n¾B¾×®É¶¡¡Aµ²ªG¬O¡G®ö¶O¤F§ó¦h®É¶¡¡A¥B¤@µL©Ò¦¨¡I
ªð¦^¦Cªí ¤W¤@¥DÃD