Andy2483

¦^´_ 29# 198188


   ²q¶Ã½X¦³Ãö,¸Õ¸Õ¬Ý¦p¤U

¤U¸ü (86.31 KB)

2024-1-3 09:41

­×§ï¬°¦p¤U¦A¸Õ¸Õ

¤U¸ü (74.83 KB)

2024-1-3 09:42

198188

¦^´_ 31# Andy2483


    §Ú¤@§ï¡Aexcel ´N¦Û°ÊÃö³¬¡C:'(  ¸Õ¤F«Ü¦h¦¸¡A³£¬O³o¼Ë

Andy2483

¦^´_ 32# 198188


    §â¸ê®Æ»PVBA·h¨ì·s¶}Àɮ׸ոլÝ

198188

¦^´_ 33# Andy2483


    ­«½Æ¤£Â_¸Õ¤F´X¤Q¹M¡A²×©ó¥i¥H¤F¡CÁÂÁ¡C

Andy2483

¦^´_ 34# 198188


    ÁÂÁ«e½ú¦^´_
¦pªG¦³´ú¸Õµ²½×©Î¸Ñ¨M¤èªk¥i¥H¤À¨É¤@¤U

198188

¦^´_ 35# Andy2483


    ®Ú¾Ú§A»¡ªº¨º¼Ë¡A¶Ã½X´«¦¨­^¤å¡A³o¼Ë´N¥i¥H¤F
¥t¥~ÁÙ¦³¤@­Ó¤pªº°ÝÃD
¯à¤£¯à¿W¥ß°µ¤@­ÓVBA §â¥þ³¡sheets ùØ­±ªº¤å¦r«ö·Óªþ¥óTranslate³o­Óªíùتº¸ê®Æ¶i¦æ¨ú¥N¡A
Á|¨Ò
±ÆÂdªí        Container Maps
³fÂd¸¹        Project Name
³fª«        Description
³fÂd¤Ø¤o        Container Size
¥X³f¤é´Á        Ex-Work Date
Âd¸¹        Container No
¨îªí¤H        Prepared By
¨îªí¤é        Date
¤W¬[        Upper Crate
¤U¬[        Lower Crate
¨®ÀY        Container Head
¬[ªø        Shelf Length

¦pªGsheet ùØ­±¦³¡§±ÆÂdªí¡¨ªº¦r²´¡A¨º麽°õ¦æµ{¦¡¦Z¡A¡§Container Maps¡¨ ¨ú¥N¡§±ÆÂdªí¡¨

Andy2483

¦^´_ 36# 198188


    ¿ý»s¥¨¶°´N¥i¥H°µ,½Ð¥ý¸Õ¸Õ¬Ý
¦A¥H°Æµ{¦¡ªº¤è¦¡±Æ¤J¥Dµ{¦¡¸Ì°õ¦æ

Andy2483

¦^´_ 36# 198188

Option Explicit
Sub Map()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim Brr, Crr, Ar, Arr, V, Z, A, i&, R&, C%, j%, T$, K$, Qs$, Qd$, No$, Mk$, Q$, S%
For i = Worksheets.Count To 4 Step -1: Worksheets(i).Delete: Next
Set Z = CreateObject("Scripting.Dictionary")
Brr = Sheets(3).UsedRange
For i = 1 To UBound(Brr): Z(Trim(Brr(i, 1))) = Trim(Brr(i, 2)): Next: S = Z.Count
Brr = Union(Sheets(1).UsedRange, Sheets(1).UsedRange.Offset(1))
Crr = Range(Sheets(2).[A1], Sheets(2).UsedRange): K = [B1]
For i = 1 To UBound(Brr) - 1
   If InStr(Brr(i, 1), Left(K, 4)) = 0 Then GoTo i01
   A = Split(Replace(Brr(i, 1), "  ", " "), " "): Q = Mid(A(0), 5, 4): Qd = A(1)
   If UBound(A) > 1 Then Qs = A(UBound(A)) Else Qs = ""
   A = Z(Q): R = Z(Q & "/r"): C = 1
   If Not IsArray(A) Then A = Crr: A(3, 2) = Q: A(3, 6) = Qs: A(3, 9) = Qd: A(4, 13) = Date: R = 5
   R = R + 1: V = A(R, 2)
   If InStr(Brr(i, 2), V) = 0 Or R = 10 Then GoTo i01
   For j = 2 To UBound(Brr, 2)
      C = C + 2: T = Trim(Brr(i, j)): If T = "" Then GoTo j01
      If InStr(T, V) Then
         A(R, C) = Mid(T, 4, 6): A(R, C + 1) = Replace(Mid(T, 11), ")", "")
         Else
         Ar = Split(T, Chr(10))
         For Each Arr In Ar
            If Not Split(Arr & " ", " ")(1) Like "[A-z][A-z]" Then GoTo j01
            No = No & Chr(10) & Split(Arr, " ")(0): Mk = Mk & Chr(10) & Mid(Arr, InStr(Arr, Split(Arr, " ")(1)))
         Next
         A(R, C) = Mid(No, 2): A(R, C + 1) = Mid(Mk, 2): No = "": Mk = ""
      End If
j01: Next
   Z(Q) = A: Z(Q & "/r") = R
i01: Brr(i + 1, 1) = IIf(Brr(i + 1, 1) = "", Brr(i, 1), Brr(i + 1, 1))
Next
If Z.Count = 0 Then Exit Sub
For Each A In Z.KEYS
   If Not IsArray(Z(A)) Then GoTo A01 Else Sheets(2).Copy After:=Worksheets(Sheets.Count)
   ActiveSheet.Name = A '"Result " & A
   [A1].Resize(UBound(Z(A)), UBound(Z(A), 2)) = Z(A)
   For i = 0 To S - 1: ActiveSheet.UsedRange.Replace Z.KEYS()(i), Z.ITEMS()(i), Lookat:=xlPart: Next
A01: Next
Application.Goto Sheets(1).[A1]
End Sub

198188

¦^´_ 38# Andy2483


   §Ú¦Û¤v¥[¤F½Ķªºµ{¦¡¡A¦ý¬O§Ú¦bexcel¥[´¡¤@­ÓSHEET ¦Z¡A°õ¦æ§Aªº¨º­ÓVBA¡A·|§R°£§Ú¥[´¡ªº¨º­ÓSHEET. ½Ð°Ý¬O­þùتº°ÝÃD¡H

Andy2483

¦^´_ 39# 198188


For i = Worksheets.Count To 3 Step -1
´«¦¨
For i = Worksheets.Count To 4 Step -1

PS:
¸Õ¸Õ#38