Board logo

¼ÐÃD: [µo°Ý] Ū¨ú¤ÎÂkÃþ¸ê®Æ [¥´¦L¥»­¶]

§@ªÌ: 198188    ®É¶¡: 2023-12-20 11:57     ¼ÐÃD: Ū¨ú¤ÎÂkÃþ¸ê®Æ

¥ªÃä¬O¸ê®ÆÀÉ¡A¥kÃä¬Oµ²ªG
®Ú¾Ú¥ªÃ䪺¨C­ÓÂdªº±Æ¦Cªí¡A¦b¥kÃä¤À§OÅã¥Ü¥X¨C­ÓÂdªº©ú²ÓSR¸¹½X

[attach]37157[/attach][attach]37157[/attach][attach]37157[/attach]
§@ªÌ: singo1232001    ®É¶¡: 2023-12-22 05:40

¦^´_ 1# 198188


    Sub test()
r = Cells(Rows.Count, 1).End(3).Row
c = 7
Range("H2:J1000").ClearContents
For i = 3 To r
If Cells(i, 1).Value <> "" Then
tx = Split(Cells(i, 1).Value, " ")(0)
mr = Cells(i, 1).MergeArea.Count
If mr > 0 Then
For Each Z In Cells(i, 2).Resize(mr - 1, 5)
If UCase(Z.Value) Like "*SR*" Then
sp = Split(Z.Value, "(")(0)
sp = Replace(sp, "¤W¬[", "")
sp = Replace(sp, "¤U¬[", "")
sp = Replace(sp, " ", "")
tx = tx & "¡¶" & sp
End If

Next
c = c + 1
sp0 = Split(tx, "¡¶")
Cells(2, c).Resize(UBound(sp0) + 1, 1) = Application.Transpose(sp0)
End If
End If
Next
End Sub
§@ªÌ: 198188    ®É¶¡: 2023-12-22 09:15

¦^´_ 2# singo1232001


        «D±`·PÁ¡I¯à¤£¯à¦³ª`ÄÀ¤@¤U¡A³o¼Ë§Ú¥i¥H§ó¦n²z¸Ñ¨C¥y¥Î·N¡A¦pªG®æ¦¡©ÎªÌªí®æ¦³ÅÜ°Ê¡A¤]¥i¥H¦Û¤v°µ¥X­×§ï¡C:handshake
§@ªÌ: singo1232001    ®É¶¡: 2023-12-22 17:21

¦^´_ 3# 198188

GPT4
Sub test()
    ' ©w¸qÅܶq¨Ãªì©l¤ÆÅܶqr¬°²Ä¤@¦C³Ì«á¤@­Ó«DªÅ¦æªº¦æ¸¹
    r = Cells(Rows.Count, 1).End(xlUp).Row
    ' ªì©l¤Æ¿é¥X°_©lªº¦C¸¹c¬°²Ä7¦C¡]§YG¦C¡^
    c = 7

    ' ²M°£±qH2¨ìJ1000ªº¤º®e¡A¬°·sªº¿é¥X°µ·Ç³Æ
    Range("H2:J1000").ClearContents

    ' ±q²Ä¤T¦æ¶}©l°j°é¡Aª½¨ì³Ì«á¤@­Ó«DªÅ¦æ
    For i = 3 To r
        ' Àˬd·í«e¦æ²Ä¤@¦Cªº³æ¤¸®æ¬O§_¤£¬°ªÅ
        If Cells(i, 1).Value <> "" Then
            ' ³q¹L¤À³Î³æ¤¸®æ­È¨Ã¨ú²Ä¤@­Ó¤¸¯À¨Ó´£¨ú¥ô°È¥N½X
            tx = Split(Cells(i, 1).Value, " ")(0)
            ' ½T©w·í«e³æ¤¸®æ¦X¨Ö°Ï°ìªº¼Æ¶q
            mr = Cells(i, 1).MergeArea.Count
            ' ¦pªG¦s¦b¦X¨Öªº³æ¤¸®æ
            If mr > 0 Then
                ' ¹M¾ú¦X¨Ö°Ï°ì¤¤ªº¨C­Ó³æ¤¸®æ¡A±Æ°£²Ä¤@­Ó³æ¤¸®æ¡]¦]¦¹¨Ï¥Îmr - 1¡^
                For Each Z In Cells(i, 2).Resize(mr - 1, 5)
                    ' ¦pªG³æ¤¸®æ¥]§t"SR"¦r¼Ë
                    If UCase(Z.Value) Like "*SR*" Then
                        ' ¤À³Î­È¥HÀò¨úSR½s¸¹¡A¥h°£¬A¸¹
                        sp = Split(Z.Value, "(")(0)
                        ' ±qSR½s¸¹¤¤²¾°£"¤W¬["¡B"¤U¬["©MªÅ®æ
                        sp = Replace(sp, "¤W¬[", "")
                        sp = Replace(sp, "¤U¬[", "")
                        sp = Replace(sp, " ", "")
                        ' ¥Î"¡¶"§@¬°¤À¹j²Å¡A±NSR½s¸¹ªþ¥[¨ì¥ô°È¥N½X«á­±
                        tx = tx & "¡¶" & sp
                    End If
                Next
                ' ²¾°Ê¨ì¤U¤@¦C¿é¥X¦ì¸m
                c = c + 1
                ' ³q¹L¤À¹j²Å"¡¶"¤À³Î½sĶ«áªº¥ô°È¥N½X©MSR½s¸¹
                sp0 = Split(tx, "¡¶")
                ' ±NSR½s¸¹¼Æ²ÕÂà¸m¨Ã±q·í«e¦C¶}©l¼g¤J¤u§@ªí
                Cells(2, c).Resize(UBound(sp0) + 1, 1) = Application.Transpose(sp0)
            End If
        End If
    Next
End Sub
³o¬qVBA§»ªº¥Øªº¬O±N¥ô°È¦Cªí¤¤ªº¡§SR¡¨½s¸¹®Ú¾Ú²Ä¤@¦C«ü©wªº¥ô°È¾ã²z¨ì¤£¦Pªº¦C¤¤¡C¥¦·|¥ý²M°£«ü©w½d³òªº¤º®e¡A±µµÛ³B²z¸ê®Æ¨Ã¤À³Î¦r¦ê¡A³Ì«á±N¾ã²z¦nªº¿é¥XÂà¸m¦Ü¤u§@ªí¤¤¡C³o¨Çµù¸ÑÀ³¸Ó¯àÀ°§U§A²z¸Ñ³o­Ó§»ªºÅÞ¿è©M¬yµ{¡C
§@ªÌ: ­ã´£³¡ªL    ®É¶¡: 2023-12-23 14:45

¨Ï¥Î°}¦C³B²z//AÄ椣¦X¨Ö¤]¥i¥H..¥u»{«DªÅ
Sub Test_A1()
Dim Arr, Brr, i&, j%, R&, Rx&, C%, X%, T$
Arr = Range([f1], [a65536].End(3).MergeArea)
ReDim Brr(1 To UBound(Arr) * 5, 1 To 99)
For i = 3 To UBound(Arr)
    T = Split(Arr(i, 1) & " ", " ")(0)
    If T Like "BF¤uµ{[#]###" Then C = C + 1: R = 1: Brr(R, C) = T
    For j = 2 To UBound(Arr, 2)
        T = Split(Arr(i, j) & " ", " ")(1)
        If T Like "SR####(*" Then R = R + 1: Brr(R, C) = Split(T, "(")(0)
    Next j
    If R > Rx Then Rx = R
Next i
With Range("H2")
     .CurrentRegion.Clear
     .Resize(Rx, C) = Brr
End With
End Sub
§@ªÌ: Andy2483    ®É¶¡: 2023-12-25 15:03

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-12-26 08:36 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:
[attach]37178[/attach]

°õ¦æµ²ªG:
[attach]37179[/attach]

Option Explicit
Sub TEST()
Dim ¸ê®Æ°}¦C, ªÅ°}¦C, ¦r¨å, ¥N¸¹$, i&, j%, µ²ªG¦C¸¹&, µ²ªGÄ渹%, µ²ªGÄæ¼Æ%, ³Ì¤j¦C¼Æ%, ¤uµ{§O$, ÃöÁä¦r$
Set ¦r¨å = CreateObject("Scripting.Dictionary")
ÃöÁä¦r = Left([B2], 4)
¸ê®Æ°}¦C = Range([F3], [B65536].End(3)(2, 0))
ReDim ªÅ°}¦C(1 To 1000, 1 To 100)
For i = 1 To UBound(¸ê®Æ°}¦C) - 1
   If InStr(¸ê®Æ°}¦C(i, 1), ÃöÁä¦r) = 0 Then GoTo i01
   µ²ªGÄ渹 = IIf(¤uµ{§O <> ¸ê®Æ°}¦C(i, 1), µ²ªGÄ渹 + 1, µ²ªGÄ渹)
   ¦r¨å(i) = µ²ªGÄ渹
   ¤uµ{§O = ¸ê®Æ°}¦C(i, 1)
   ¦r¨å(µ²ªGÄ渹 & "/r") = 1
   ªÅ°}¦C(1, µ²ªGÄ渹) = Split(¸ê®Æ°}¦C(i, 1), " ")(0)
   ¸ê®Æ°}¦C(i + 1, 1) = IIf(¸ê®Æ°}¦C(i + 1, 1) = "", ¸ê®Æ°}¦C(i, 1), ¸ê®Æ°}¦C(i + 1, 1))
i01: Next
µ²ªGÄæ¼Æ = µ²ªGÄ渹
For j = 2 To UBound(¸ê®Æ°}¦C, 2)
   For i = 1 To UBound(¸ê®Æ°}¦C)
      ¥N¸¹ = Split(¸ê®Æ°}¦C(i, j) & " ", " ")(1)
      If Not ¥N¸¹ Like "[A-Z][A-Z]####*" Or ¦r¨å(i) = 0 Then GoTo i02
      µ²ªGÄ渹 = ¦r¨å(i)
      µ²ªG¦C¸¹ = ¦r¨å(µ²ªGÄ渹 & "/r")
      µ²ªG¦C¸¹ = µ²ªG¦C¸¹ + 1: ¦r¨å(µ²ªGÄ渹 & "/r") = µ²ªG¦C¸¹
      ªÅ°}¦C(µ²ªG¦C¸¹, ¦r¨å(i)) = Left(¥N¸¹, 6)
      If ³Ì¤j¦C¼Æ < µ²ªG¦C¸¹ Then ³Ì¤j¦C¼Æ = µ²ªG¦C¸¹
i02: Next
Next
With [H2]
     .CurrentRegion.ClearContents
     .Resize(³Ì¤j¦C¼Æ, µ²ªGÄæ¼Æ) = ªÅ°}¦C
End With
End Sub
§@ªÌ: 198188    ®É¶¡: 2023-12-29 14:10

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

°õ¦æ®É¡A¨ì    Brr(R, C) = Split(T, "(")(0)³oùØ¥X¿ù¡C
¯à¤£¯àª`ÄÀ¤@¤Uµ{¦¡ªº·N«ä¡A¤è«K§Ú¥i¥H¾Ç²ß¡AÁÂÁ¡I
§@ªÌ: 198188    ®É¶¡: 2023-12-30 10:03

[attach]37210[/attach][attach]37211[/attach]¦^´_ 2# singo1232001


°e³f³æ
®Ú¾Ú¨C­Ósheet  ±q¥ªÃä°e³f³æ¸ê®Æ©â¨ú¸ê®Æ¡A½Æ»s¨ì¥kÃä¡C
®Ú¾ÚAÄ檺¸ê®Æ½Æ»s¦³¤Ø¤oªº¸ê®Æ¨ìNÄæ¡A¦P®É½Æ»sÄæB¨ìÄæP & ÄæC¨ìÄæQµM«á§â³oÄ檺¸ê®Æ¤À³Î¶}¨ìÄæO, R, S, T,
¤§«á½Æ»sÄæO¨ìÄæV , µM«á®Ú¾ÚÄæOªº³f¬[¸¹Åª¨úÄæG ¨ìÄæW, ÄæF ¨ìÄæX, ÄæJ¨ìÄæY

±Æ¬[ªí
®Ú¾ÚBF ùØÄæAªº¸ê®Æ¡A¦³#001 - #009 ¡]³o­Ó¤£©T©w¦³¦h¤Ö­Ó¡^½ÆÂø·sªºSHEET ¥H#001 - #009 ¤À§O©R¦W
BF ùØÄæA ªº#001 ¡AùØ­±¦³¤@¨ÇSR****¡A®Ú¾Ú³o¨ÇSR**** Ū¨ú±Æ¬[ªíùØ­±ªº¸ê®Æ½Æ»s¨ìSHEET #001 ùØ­±¡AµM«á°µ¤@­Ó¼Ï¯Ã¤ÀªRªí
BF ùØÄæA ªº#002 ¡AùØ­±¦³¤@¨ÇSR****¡A®Ú¾Ú³o¨ÇSR**** Ū¨ú±Æ¬[ªíùØ­±ªº¸ê®Æ½Æ»s¨ìSHEET #002ùØ­±¡AµM«á°µ¤@­Ó¼Ï¯Ã¤ÀªRªí
BF ùØÄæA ªº#003 ¡AùØ­±¦³¤@¨ÇSR****¡A®Ú¾Ú³o¨ÇSR**** Ū¨ú±Æ¬[ªíùØ­±ªº¸ê®Æ½Æ»s¨ìSHEET #003ùØ­±¡AµM«á°µ¤@­Ó¼Ï¯Ã¤ÀªRªí
BF ùØÄæA ªº#004 ¡AùØ­±¦³¤@¨ÇSR****¡A®Ú¾Ú³o¨ÇSR**** Ū¨ú±Æ¬[ªíùØ­±ªº¸ê®Æ½Æ»s¨ìSHEET #004ùØ­±¡AµM«á°µ¤@­Ó¼Ï¯Ã¤ÀªRªí
¦p¦¹Ãþ±À
§@ªÌ: 198188    ®É¶¡: 2023-12-30 10:04

[attach]37212[/attach][attach]37213[/attach]¦^´_ 5# ­ã´£³¡ªL

°e³f³æ
®Ú¾Ú¨C­Ósheet  ±q¥ªÃä°e³f³æ¸ê®Æ©â¨ú¸ê®Æ¡A½Æ»s¨ì¥kÃä¡C
®Ú¾ÚAÄ檺¸ê®Æ½Æ»s¦³¤Ø¤oªº¸ê®Æ¨ìNÄæ¡A¦P®É½Æ»sÄæB¨ìÄæP & ÄæC¨ìÄæQµM«á§â³oÄ檺¸ê®Æ¤À³Î¶}¨ìÄæO, R, S, T,
¤§«á½Æ»sÄæO¨ìÄæV , µM«á®Ú¾ÚÄæOªº³f¬[¸¹Åª¨úÄæG ¨ìÄæW, ÄæF ¨ìÄæX, ÄæJ¨ìÄæY

±Æ¬[ªí
®Ú¾ÚBF ùØÄæAªº¸ê®Æ¡A¦³#001 - #009 ¡]³o­Ó¤£©T©w¦³¦h¤Ö­Ó¡^½ÆÂø·sªºSHEET ¥H#001 - #009 ¤À§O©R¦W
BF ùØÄæA ªº#001 ¡AùØ­±¦³¤@¨ÇSR****¡A®Ú¾Ú³o¨ÇSR**** Ū¨ú±Æ¬[ªíùØ­±ªº¸ê®Æ½Æ»s¨ìSHEET #001 ùØ­±¡AµM«á°µ¤@­Ó¼Ï¯Ã¤ÀªRªí
BF ùØÄæA ªº#002 ¡AùØ­±¦³¤@¨ÇSR****¡A®Ú¾Ú³o¨ÇSR**** Ū¨ú±Æ¬[ªíùØ­±ªº¸ê®Æ½Æ»s¨ìSHEET #002ùØ­±¡AµM«á°µ¤@­Ó¼Ï¯Ã¤ÀªRªí
BF ùØÄæA ªº#003 ¡AùØ­±¦³¤@¨ÇSR****¡A®Ú¾Ú³o¨ÇSR**** Ū¨ú±Æ¬[ªíùØ­±ªº¸ê®Æ½Æ»s¨ìSHEET #003ùØ­±¡AµM«á°µ¤@­Ó¼Ï¯Ã¤ÀªRªí
BF ùØÄæA ªº#004 ¡AùØ­±¦³¤@¨ÇSR****¡A®Ú¾Ú³o¨ÇSR**** Ū¨ú±Æ¬[ªíùØ­±ªº¸ê®Æ½Æ»s¨ìSHEET #004ùØ­±¡AµM«á°µ¤@­Ó¼Ï¯Ã¤ÀªRªí
¦p¦¹Ãþ±À
§@ªÌ: ­ã´£³¡ªL    ®É¶¡: 2023-12-30 16:47

¦^´_ 7# 198188


°õ¦æ¨S°ÝÃD!!!
split ¥Î¨Ó¤À³Î¤å¦r, "(" ¬O¤À³Î²Å
§@ªÌ: ­ã´£³¡ªL    ®É¶¡: 2023-12-31 11:46

¦^´_ 9# 198188

¥ýµ¹"°e³f³æ"//
µ{¦¡½X¨S¤°¯S§O~~
[attach]37214[/attach]
§@ªÌ: ­ã´£³¡ªL    ®É¶¡: 2024-1-1 13:03

¦^´_ 9# 198188

±Æ¬[ªí..°j°é¦h¼h, ¦Û¦æ¬ã¨s//
[attach]37216[/attach]
§@ªÌ: 198188    ®É¶¡: 2024-1-2 10:07

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

¦]爲Ác²Åé°ÝÃD¡A¾É­P¶Ã½X¡A¾É­PµLªk¹B¦æ¡C ¦]爲¨S¦³­ì¤å¡A§ÚµLªk­×¥¿¶Ã½X³¡¤À¡C¥i§_µo¤@¤U­ì¤åµ¹§Ú­×¥¿¡C
Sub ¤à()
Dim Arr, Xrr, Yrr, i&, j%, V, T$, T1$, TR, x&, y&
Call 睲®J¤à
Arr = Range([L1], [A65536].End(xlUp).MergeArea)
ReDim Xrr(1 To UBound(Arr), 1 To 7)
ReDim Yrr(1 To UBound(Arr), 1 To 4)
For i = 15 To UBound(Arr)
    T = Arr(i, 1): V = Val(Arr(i, 10))
    If T Like "*L *W *H *" Then
       TR = Split(T, Chr(10)): T1 = Trim(TR(0))
       x = x + 1
       Xrr(x, 1) = T  'A °f£VÇ_计ªq
       Xrr(x, 2) = T1 'ÒÝ琜¸¡
       Xrr(x, 3) = Arr(i, 2) 'N.W.(瞓)
       Xrr(x, 4) = Arr(i, 3) 'G.W.(Çy)
       Xrr(x, 5) = Val(Mid(TR(3), 2)) 'W
       Xrr(x, 6) = Val(Mid(TR(2), 2)) 'L
       Xrr(x, 7) = Val(Mid(TR(4), 2)) 'H
    End If
    '----------------------------------
    If T1 <> "" And Arr(i, 6) <> "" And V <> 0 Then
       y = y + 1
       Yrr(y, 1) = T1 'ÒÝ琜¸¡
       Yrr(y, 2) = Arr(i, 7) '竚
       Yrr(y, 3) = Arr(i, 6) 'ÇA甧
       Yrr(y, 4) = V '计Ïü
    End If
i01: Next i
If x = 0 Then Exit Sub
With [N3].Resize(x, 7)
     .Value = Xrr
     .Borders.LineStyle = 1
     .WrapText = False
End With
With [v3].Resize(y, 4)
     .Value = Yrr
     .Borders.LineStyle = 1
End With
End Sub

Sub 睲®J?)
Range([T3], [N65536].End(xlUp)(3)).Delete Shift:=xlUp
Range([Y3], [V65536].End(xlUp)(3)).Delete Shift:=xlUp
End Sub
§@ªÌ: 198188    ®É¶¡: 2024-1-2 10:09

¦^´_ 12# ­ã´£³¡ªL
¦]爲Ác²Åé°ÝÃD¡A¾É­P¶Ã½X¡A¾É­PµLªk¹B¦æ¡C ¦]爲¨S¦³­ì¤å¡A§ÚµLªk­×¥¿¶Ã½X³¡¤À¡C¥i§_µo¤@¤U­ì¤åµ¹§Ú­×¥¿¡C

Sub ╊ÇG()
Attribute ╊ÇG.VB_Description = "Å÷场Ò§  2024/1/1 »íÐFǤ栋"
Attribute ╊ÇG.VB_ProcData.VB_Invoke_Func = " \n14"
Dim Arr, Brr, Drr, Xrr, Yrr, xD, xS As Worksheet, vS As Worksheet, R&, S$, T$, i&, j&, k%, x&, y%, N&
Call ®J
Set xD = CreateObject("Scripting.Dictionary")
Set vS = Sheets("¹G琜"): Xrr = vS.[a8:f8]
Arr = Range(vS.[b1], vS.[d65536].End(xlUp))
For i = 9 To UBound(Arr)
    T = Arr(i, 2)
    If T Like "SR####" Then xD(T) = vS.Cells(i, 2).MergeArea.Resize(, 5).Value
Next i
'-----------------------------
Set xS = Sheets("BF")
Arr = Range(xS.[f1], xS.[a65536].End(xlUp).MergeArea)
For i = 2 To UBound(Arr)
    If Arr(i, 1) Like "BF祘[#]###*" Then
       S = Mid(Arr(i, 1), 5, 4): N = 0
       Brr = xS.Cells(i, 1).MergeArea.Resize(, 5).Value
       ReDim Yrr(1 To 2000, 1 To 6)
       N = N + 1
       For y = 1 To 6: Yrr(N, y) = Xrr(1, Mid(123645, y, 1)): Next
       For j = 1 To UBound(Brr)
           For k = 2 To UBound(Brr, 2)
               If Brr(j, k) Like "*琜*SR####*" Then
                  T = Mid(Brr(j, k), 4, 6)
                  Drr = xD(T)
                  If IsArray(Drr) Then
                     For x = 1 To UBound(Drr)
                         N = N + 1
                         Yrr(N, 1) = "=row()-1"
                         Yrr(N, 2) = Drr(1, 1)
                         Yrr(N, 3) = Drr(1, 2)
                         Yrr(N, 4) = Drr(1, 5)
                         Yrr(N, 5) = Drr(1, 3)
                         Yrr(N, 6) = Drr(1, 4)
                     Next x
                  End If
               End If
           Next k
       Next j
       '-----------------------------------
       If N <= 1 Then GoTo i01
       Set vS = Sheets.Add(after:=vS): vS.Name = S
       With vS.[a1].Resize(N, 6)
            .Value = Yrr
            .Borders.LineStyle = 1
            .Sort Key1:=.Item(3), Order1:=xlAscending, _
                  Key2:=.Item(4), Order2:=xlAscending, _
                  Key3:=.Item(2), Order3:=xlAscending, Header:=xlYes
            T = "'" & S & "'!" & .Address
       End With
       '-----------------------------------
       ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=T).CreatePivotTable TableDestination:=vS.Range("i1"), TableName:="Pvt_1"
       vS.PivotTables("Pvt_1").AddFields RowFields:=vS.Range("C1"), ColumnFields:=vS.Range("d1")
       vS.PivotTables("Pvt_1").PivotFields(vS.Range("F1").Text).Orientation = xlDataField
    End If
    Application.CommandBars("PivotTable").Visible = False
i01: Next i
End Sub

Sub ®J()
Dim xS As Worksheet
Application.DisplayAlerts = False
For Each xS In Sheets
    If xS.Name Like "[#]###" Then xS.Delete
Next
End Sub


Sub ttt()
MsgBox Val("11 22")
End Sub
Sub Macro2()
'
' Macro2 Ǥ栋
' Å÷场Ò§  2024/1/1 »íÐFǤ栋
'

'
'   Columns("B:F").Select
  ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="'#001'!C1:f86").CreatePivotTable TableDestination:=Range("i1"), TableName:="ÏEÇG猂1"
    'ActiveSheet.PivotTables("ÏEÇG猂1").SmallGrid = False
    ActiveSheet.PivotTables("ÏEÇG猂1").AddFields RowFields:=Range("C1"), ColumnFields:=Range("d1")
    ActiveSheet.PivotTables("ÏEÇG猂1").PivotFields(Range("F1").Text).Orientation = xlDataField
End Sub
§@ªÌ: ­ã´£³¡ªL    ®É¶¡: 2024-1-2 14:16

¡Õ°e³f³æ¡Ö

Sub ¨ú¥X¸ê®Æ()
Dim Arr, Xrr, Yrr, i&, j%, V, T$, T1$, TR, x&, y&
Call ²M°£¸ê®Æ
Arr = Range([L1], [A65536].End(xlUp).MergeArea)
ReDim Xrr(1 To UBound(Arr), 1 To 7)
ReDim Yrr(1 To UBound(Arr), 1 To 4)
For i = 15 To UBound(Arr)
    T = Arr(i, 1): V = Val(Arr(i, 10))
    If T Like "*L *W *H *" Then
       TR = Split(T, Chr(10)): T1 = Trim(TR(0))
       x = x + 1
       Xrr(x, 1) = T  'A Ä榳¤Ø¤oªº¼Æ¾Ú
       Xrr(x, 2) = T1 '³f¬[¸¹
       Xrr(x, 3) = Arr(i, 2) 'N.W.(²b­«)
       Xrr(x, 4) = Arr(i, 3) 'G.W.(¤ò­«)
       Xrr(x, 5) = Val(Mid(TR(3), 2)) 'W
       Xrr(x, 6) = Val(Mid(TR(2), 2)) 'L
       Xrr(x, 7) = Val(Mid(TR(4), 2)) 'H
    End If
    '----------------------------------
    If T1 <> "" And Arr(i, 6) <> "" And V <> 0 Then
       y = y + 1
       Yrr(y, 1) = T1 '³f¬[¸¹
       Yrr(y, 2) = Arr(i, 7) '¦ì¸m
       Yrr(y, 3) = Arr(i, 6) '¤º®e
       Yrr(y, 4) = V '¼Æ¶q
    End If
i01: Next i
If x = 0 Then Exit Sub
With [N3].Resize(x, 7)
     .Value = Xrr
     .Borders.LineStyle = 1
     .WrapText = False
End With
With [v3].Resize(y, 4)
     .Value = Yrr
     .Borders.LineStyle = 1
End With
End Sub

Sub ²M°£¸ê®Æ()
Range([T3], [N65536].End(xlUp)(3)).Delete Shift:=xlUp
Range([Y3], [V65536].End(xlUp)(3)).Delete Shift:=xlUp
End Sub
§@ªÌ: ­ã´£³¡ªL    ®É¶¡: 2024-1-2 14:17

¡Õ±Æ¬[ªí¡Ö

Sub ©î¤À¤u§@ªí()
Dim Arr, Brr, Drr, Xrr, Yrr, xD, xS As Worksheet, vS As Worksheet, R&, S$, T$, i&, j&, k%, x&, y%, N&
Call §R°£¤u§@ªí
Set xD = CreateObject("Scripting.Dictionary")
Set vS = Sheets("±Æ¬[ªí"): Xrr = vS.[a8:f8]
Arr = Range(vS.[b1], vS.[d65536].End(xlUp))
For i = 9 To UBound(Arr)
    T = Arr(i, 2)
    If T Like "SR####" Then xD(T) = vS.Cells(i, 2).MergeArea.Resize(, 5).Value
Next i
'-----------------------------
Set xS = Sheets("BF")
Arr = Range(xS.[f1], xS.[a65536].End(xlUp).MergeArea)
For i = 2 To UBound(Arr)
    If Arr(i, 1) Like "BF¤uµ{[#]###*" Then
       S = Mid(Arr(i, 1), 5, 4): N = 0
       Brr = xS.Cells(i, 1).MergeArea.Resize(, 5).Value
       ReDim Yrr(1 To 2000, 1 To 6)
       N = N + 1
       For y = 1 To 6: Yrr(N, y) = Xrr(1, Mid(123645, y, 1)): Next
       For j = 1 To UBound(Brr)
           For k = 2 To UBound(Brr, 2)
               If Brr(j, k) Like "*¬[*SR####*" Then
                  T = Mid(Brr(j, k), 4, 6)
                  Drr = xD(T)
                  If IsArray(Drr) Then
                     For x = 1 To UBound(Drr)
                         N = N + 1
                         Yrr(N, 1) = "=row()-1"
                         Yrr(N, 2) = Drr(1, 1)
                         Yrr(N, 3) = Drr(1, 2)
                         Yrr(N, 4) = Drr(1, 5)
                         Yrr(N, 5) = Drr(1, 3)
                         Yrr(N, 6) = Drr(1, 4)
                     Next x
                  End If
               End If
           Next k
       Next j
       '-----------------------------------
       If N <= 1 Then GoTo i01
       Set vS = Sheets.Add(after:=vS): vS.Name = S
       With vS.[a1].Resize(N, 6)
            .Value = Yrr
            .Borders.LineStyle = 1
            .Sort Key1:=.Item(3), Order1:=xlAscending, _
                  Key2:=.Item(4), Order2:=xlAscending, _
                  Key3:=.Item(2), Order3:=xlAscending, Header:=xlYes
            T = "'" & S & "'!" & .Address
       End With
       '-----------------------------------
       ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=T).CreatePivotTable TableDestination:=vS.Range("i1"), TableName:="Pvt_1"
       vS.PivotTables("Pvt_1").AddFields RowFields:=vS.Range("C1"), ColumnFields:=vS.Range("d1")
       vS.PivotTables("Pvt_1").PivotFields(vS.Range("F1").Text).Orientation = xlDataField
    End If
    Application.CommandBars("PivotTable").Visible = False
i01: Next i
End Sub

Sub §R°£¤u§@ªí()
Dim xS As Worksheet
Application.DisplayAlerts = False
For Each xS In Sheets
    If xS.Name Like "[#]###" Then xS.Delete
Next
End Sub
§@ªÌ: 198188    ®É¶¡: 2024-1-2 16:16

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


    ¥¼§K¦]爲¤¤¤å¶Ã½XµLªk¹B¦æ¡A§ï¤F­^¤å¡A¦ý¬O¥X¨Óªºµª®×¸ò»Ý¨D¤£¤@¼Ë¡C
²Ä¤@, §Ç¸¹¤£¬OCOPY  ¡§SR/±Æ¬[ªí" ùتº§Ç¸¹¡A¦Ó¬O¨C¦¸«ö¶¶§Ç
²Ä¤G¡A¼Ó¼h¦³³¡¤À¤]¤£¬O®Ú¾Ú¡§SR/±Æ¬[ªí" ùؼӼh
²Ä¤T, ³æ¤¸À³¸Ó¤]¬O«ö·Ó¡§SR/±Æ¬[ªí" ùس椸Ū¨ú¡A¤£¹L¥X¨Óªº¬O©Ò¦³³f¬[§Ç¸¹ùتº²Ä¤@­Ó³æ¤¸
Á|¨Ò ¤U­±¬OSR / ©ç¬[ªí
§Ç号        货¬[编号        货¬[§Ç号        单¤¸        数¶q        楼层
8                      GS201        SR2001                 FC130               1        02F       
9                                                                 FC117          1        02F       
10                                                                 FC116               1        02F       
11                                                                 FC133            1        06F       
12                                                                 FC117                1        02F       
13                                                                 FC118                1        06F       
14                                                                 FC133                1        06F       
µM«áBF ùØ­±¦³SR2001
¥X¨Óªº®ÄªG¬O¤U­±³o¼Ë¡A´N¬Oª½±µCOPY SR2001ùØ­±ªº©Ò¦³内®e¡AµM«á³f¬[©M³f¬[§Ç¸¹Åܦ¨¤£¦X¦}¡A¦Ó¥B¶ñº¡¨C¦æ¡C
§Ç号        货¬[编号        货¬[§Ç号        楼层        单¤¸        数¶q
8                 GS201                 SR2001         02F                 FC130           1
9                 GS201                 SR2001                02F                 FC117           1
10                 GS201                 SR2001                02F          FC116           1
11                 GS201                 SR2001          02F          FC130       1
12                 GS201           SR2001                02F          FC117            1
13                 GS201                 SR2001                02F          FC116            1
14                 GS201                 SR2001                 02F         FC130             1
§@ªÌ: ­ã´£³¡ªL    ®É¶¡: 2024-1-2 19:46

¦^´_ 17# 198188

²¨©¿¨S§ï¨ì//
Yrr(N, 4) = Drr(1, 5)
Yrr(N, 5) = Drr(1, 3)
Yrr(N, 6) = Drr(1, 4)
§ï¦¨//
Yrr(N, 4) = Drr(x, 5)
Yrr(N, 5) = Drr(x, 3)
Yrr(N, 6) = Drr(x, 4)
§@ªÌ: ­ã´£³¡ªL    ®É¶¡: 2024-1-2 19:49

¦^´_ 17# 198188

§Ç¸¹¬O¥Î¤½¦¡, ¥k¤èªº¦³±Æ§Ç, ­Y¤£·Q±Æ§Ç´N¥h±¼§a!!!
§@ªÌ: 198188    ®É¶¡: 2024-1-3 08:04

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

    Yrr(N, 1) = "=row()-1" §R°£¤F³o­Ó¦Z¡A§Ç¸¹«KªÅ¥Õ¡A«ç¼Ë¤~¯àŪ¨úSR ªº¬ÛÀ³§Ç¸¹¡H§Ú¸Õ¹L§ï¤U­±ªº¤è¦¡¡A³£Åã¥Ü¿ù»~¡A¤£¯à°õ¦æµ{¦¡¡C
     Yrr(N, 1) = Drr(x, -1)
     Yrr(N, 1) = Drr(x, 0)
     Yrr(N, 1) = Drr(1, -1)
     Yrr(N, 1) = Drr(1, 0)
§@ªÌ: ­ã´£³¡ªL    ®É¶¡: 2024-1-3 14:08

¦^´_ 20# 198188

¼ÒÀÀªº¬Ý¤£¥X¨Ó¦p¦ó°µ§Ç¸¹, ¤§«e¥Î²qªº//
[attach]37230[/attach]
§@ªÌ: 198188    ®É¶¡: 2024-1-3 14:49

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


    ·PÁÂÀ°¦£
§@ªÌ: 198188    ®É¶¡: 2024-2-6 15:00

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


    https://forum.twbts.com/thread-24186-1-1.html
­ã¤j¤j¡A¥i§_À°§Ú¬Ý¬Ý³o­Ó©«¤l¡H
§@ªÌ: 198188    ®É¶¡: 2024-3-18 10:03

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


    ­ã¤j¡A¤£ª¾¹D­þùØ°ÝÃD¡A¥u¯à¥X²{SHEET "BF" ÄæB-ÄæE ªº¸ê®Æ¡AÄæF µLªkŪ¥X¨Ó¡C




Åwªï¥úÁ{ ³Â»¶®a±Ú°Q½×ª©ª© (http://forum.twbts.com/)