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

[µo°Ý] Excel ¿z¿ï«á½Æ»s¡C

[µo°Ý] Excel ¿z¿ï«á½Æ»s¡C

§Ú¦³¤@­Ó¬¡­¶Ã¯¤º¦³¦h­Ó¤u§@ªí,§Ú­n±N¬ÛÃö¤u§@ªí¥ý°µ¿z¿ï¦A½Æ»s¶K¤W°µ
¼Ï¯Ã¤ÀªRªí,¨Ò¦p¤u§@ªíQC3,QC4,QC5 ³o¤T­Ó¤u§@ªí,§Ú¬O¥Î¤½¦¡ µ¥©ó "=" ¥t¥~¤@­Ó¤u§@ªíªº¤º®e,¨º´N¬OQC3-QC5 ¥Ñ²Ä¤G¦C¶}©l,¥þ³¡¬°¤½¦¡= ¥t¥~¤@­Ó¬¡­¶Ã¯
¤ºªº¸ê®Æ¤º®e,¦P®É¦]¬°§Ú¬O¥Î¤½¦¡= ¥t¥~¤@±i¤u§@ªíªº¤º®e,©Ò¥H¦b³Ì«áªº¦C¬O·|¦³0 ªº°ÝÃD,0ªºÅã¥Ü¬O¸Ó¤u§@ªíªº¦C¨S¦³¸ê®Æ,¦]¬°§Ú¤£­n¨C¦¸³£§â¤½¦¡¦V¤U©Ô¦A¨ú¸ê®Æ,¦Ó¬O¥ý=¸Ó¤u§@ªíªº¤º®e,§Ú­n±NQC3¥ý ¿z¿ïKÄæ "year" ¬°2022-1 ¤ë¥÷,¦A¥ÑA2:K2 ¦V¤U½Æ»s¦A¶K¤W¦ÜQC Summary ªºA2 Àx¦s®æ,QC4 ¤]¬O¿z¿ï2022-1 , ¦A¥ÑA2:K2 ½Æ»s¦ÜQC Summary,¦¹®É½Æ»s¶K¤W«h¬O¦bQC3 ­è¤~½Æ»sªº¸ê®Æ¤U¤è,¦P®ÉQC5 ³£¬O¤@¼Ë°µªk,

¦ÓCLS-QC5-CLS-QC7 ¤]¬O¤@¼Ë°µªk3­Ó¤u§@ªí,³o¦¸«K¬OA2:K2½Æ»s¦ÜCLS Summary³o¼Ë, ¦ÓTotal Summary «h§Ú¥H¤â°Ê¤è¦¡,±NQC Summary ¤ÎCLS-Summary °µ¼Ï¯Ã¤ÀªRªí¾ã¦X¸ê®Æ³o¼Ë¡C

QC3-QC5 ³o¼Ë¥u¬O3­Ó¤u§@ªí,CLS-QC5-7 ¤]¬O­è¦n3­Ó,¦pªG¤U¦¸¦³·s¼Wªº¸Ü,³£»Ý­n®Ú¾Ú¤u§@ªíªº¦h¤Ö¨Ó¦Û°Ê½Æ»s¶K¤W¡C

³Ì¦n¬O¦Û°Ê»{§O¨ì¥HQC ¶}ÀYªº¤u§@ªí«h¦Û°Ê¿z¿ï½Æ»s¶K¤W¦ÜQC Summary ªí¤º,¦P®ÉCLS-¶}©lªº¤]¬O¦Û°Ê¿z¿ï¦A½Æ»s¶K¤W¡C
¦Ó2022-1 ¬O·|®Ú¾Ú¤ë¥÷¿z¿ï, ¨ì2¤ë®É,«h­n¦Û°Ê¿z¿ï2022-2¡C


©Ò¦³QC¤u§@ªí¬O¥H¤½¦¡µ¥©ó= ¥t¥~¤@±i¤u§@ªíªº¸ê®Æ,©Ò¥H­n¥H¹ê¼Æ¶K¤WSummary ¡C ¦P®É¨C±i¤u§@ªíªº¤º®e¸ê®Æ¦h¤Ö³£¤£¤@¼Ë¡C

½Ð°Ý¦p¦ó¥HVBA °µ¨ì¥H¤W­n¨D,ÁÂÁÂ
Report.rar (286.46 KB)

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-1-5 08:00 ½s¿è

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


    ÁÂÁ«e½ú,¤£³Ó·P¿E

Option Explicit
Sub TEST_A1()
Dim Brr(2), N(2), i&, Arr, SS, S As Worksheet, T$, YM$, k%, j%
'¡ô«Å§iÅܼÆ:Brr¬O¤@ºû°}¦CBrr(0)~Brr(2),N¬O¤@ºû°}¦CN(0)~N(2),
'(Arr,SS)¬O³q¥Î«¬ÅܼÆ,i¬Oªø¾ã¼Æ,S¬O¤u§@ªíÅܼÆ,(T,YM)¬O¦r¦êÅܼÆ,
'(k,j)¬Oµu¾ã¼Æ

YM = Format("2022/1/22", "yyyy-m")
'¡ô¥OYM³o¦r¦êÅܼƬO (¤é´ÁÂର4½X¦~¤À³s±µ"-",¦A³s±µ¤ë¥÷)ªº¦r¦ê
ReDim Arr(1 To 20000, 1 To 11)
'¡ô«Å§iArr³o¤Gºû°}¦C½d³ò:Áa¦V±q1¨ì20000¦C¸¹,¾î¦V±q1¨ì11Ä渹
Brr(1) = Arr
'¡ô¥O¯Á¤Þ¸¹1ªºBrr°}¦C­È¬O Arr¤Gºû°}¦C
Brr(2) = Arr
'¡ô¥O¯Á¤Þ¸¹2ªºBrr°}¦C­È¬O Arr¤Gºû°}¦C
For Each S In Sheets
'¡ô³]Each°j°é,¥OS¬O°j°é¤u§@ªí
    T = UCase(S.Name)
    '¡ô¥OT³o¦r¦êÅܼƬO S°j°é¤u§@ªí¦W¸g¦r¤¸Âà¤j¼gªº·s¦r¦ê
    k = Switch(T Like "QC#*", 1, T Like "CLS-QC#*", 2, T = T, 0)
    '¡ô¥Ok³oµu¾ã¼Æ¬O Switch ¨ç¼Æ¦^¶Çªº­È,³W«h¦p¤U:
    '¦pªG T¦r¦êÅܼƬO "QC"¶}ÀY,³s±µ¦Ü¤Ö±a¦³1½X¼Æ¦rªº³W«h,´N¦^¶Ç¼Æ¦r 1 µ¹kÅܼÆ
    '¦pªG T¦r¦êÅܼƬO "CLS-QC"¶}ÀY,³s±µ¦Ü¤Ö±a¦³1½X¼Æ¦rªº³W«h,´N¦^¶Ç¼Æ¦r 2 µ¹kÅܼÆ
    '¦pªG T¦r¦êÅܼƬO ¦Û¨­µ¥¦¡,´N¦^¶Ç¼Æ¦r 0 µ¹kÅܼÆ
    'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/switch-function

    If k = 0 Then GoTo s99
    '¡ô¦pªGkÅܼƬO 0,´N¸õ¨ì s99¦ì¸mÄ~Äò°õ¦æ
    Arr = S.Range("a1").CurrentRegion
    '¡ô¥OArr³o¤Gºû°}¦C! ­Ë¤J S°j°é¤u§@ªí[A1]¬Û¾FÀx¦s®æ¦ê¨Ã«áÂX®i¦¨ªº³Ì¤p¤è¥¿½d³òÀx¦s®æ¶°­È
    For i = 2 To UBound(Arr)
    '¡ô³]¶¶°j°é!i±q2¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹¼Æ
        If Arr(i, 5) = 0 Then Exit For
        '¡ô¦pªGi°j°é¦C5ÄæArr°}¦C­È¬O 0,´N¸õ¥Xi¼hFor°éÄ~Äò°õ¦æ
        If Arr(i, 11) = YM Then
        '¡ô¦pªGi°j°é¦C11ÄæArr°}¦C­È¬O YM¦r¦êÅܼÆ?
           N(k) = N(k) + 1
           '¡ô¥OkÅܼƯÁ¤Þ¸¹ªºN°}¦C­È¬O ¦Û¨­²Ö¥[ 1
           For j = 1 To UBound(Arr, 2)
           '¡ô³]¶¶°j°é!j±q1¨ìArr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹¼Æ
               Brr(k)(N(k), j) = Arr(i, j)
               '¡ô¥OkÅܼƯÁ¤Þ¸¹Brr°}¦C­È(¤Gºû°}¦C)¤¤ ,
               '(kÅܼƯÁ¤Þ¸¹ªºN°}¦C­È ¦C¸¹,j°j°éÄ渹),
               '²Ä¤@¦¸»{Ãѳo¼Ëªº°}¦C,³o¤£ª¾¹D¬O¤£¬O©Ò¿×ªº¤Tºû°}¦C??ÁÂÁÂ
               '³o¤Tºû°}¦C­È¬O i°j°é¦Cj°j°éÄæArr°}¦C­È

           Next j
        End If
    Next i
s99: Next
Set SS = Sheets(Array("QC Summary", "CLS Summary"))
'¡ô¥OSS³o³q¥Î«¬ÅܼƬO¤u§@ªí¶°
For k = 1 To 2
'¡ô³]¶¶°j°é!k±q1¨ì2
    SS(k).UsedRange.Offset(1, 0).EntireRow.Delete
    '¡ô¥OSSÅܼƤu§@ªí¶°k¯Á¤Þ¸¹¤u§@ªí,¨Ï¥ÎªºÀx¦s®æÂX®i³Ì¤p¤è¥¿Àx¦s®æ¶°,
    '¦V¤U°¾²¾¤@¦CªºÀx¦s®æ¶°½d³ò¦C§R°£

    If N(k) > 0 Then SS(k).[a2].Resize(N(k), 11) = Brr(k)
    '¡ô¦pªGkÅܼƯÁ¤Þ¸¹ªºN°}¦C­È >0 ,´N¥OSSÅܼƤu§@ªí¶°k¯Á¤Þ¸¹¤u§@ªí,
    '[a2]ÂX®i¦V¤U kÅܼƯÁ¤Þ¸¹ªºN°}¦C­È¦C,¦V¥kÂX®i11Äæ,³o½d³òÀx¦s®æ,
    '¥HBrr¤Tºû°}¦Cªº²Äk¯Á¤Þ¸¹¼h°}¦C±a¤J,ÁÂÁÂ

Next k
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 5# stephenlee


¦pªG´ú¸ÕÀɳ£¨S°ÝÃD, ¬O§_¥i¯à¹ê»Ú¸ê®Æ¦³¤½¦¡²£¥Íªº¿ù»~­È???
¦Û¦æ¥ý§ä¨ì¿ù»~©Ò¦b, §Y¿ù»~¦b¸ê®Æ, ¦Ó¤£¬Oµ{¦¡, ³o­n¦Û¤v­×§ï¤½¦¡¥h°£¿ù»~

TOP

¥»©«³Ì«á¥Ñ stephenlee ©ó 2022-2-4 10:34 ½s¿è
Sub TEST_A1()
Dim Arr, Brr(2), N(2), i&, j%, YM$, SS, S As Worksheet, T$, k%
YM = Format(Date, "yy ...
­ã´£³¡ªL µoªí©ó 2022-1-30 08:59


·PÁ²a¤j,§Ú³o¨Ç¸ê®Æ¨Ó·½¬O¥Î¤½¦¡= ¨ä¥L¤u§@ªí¤ºªº¸ê®Æ, ¶K¤W«ü¥O½X«á,¥L¦b13¦æ,¥H¤U¥y¤l¤¤¥X²{¿ù»~»¡


²Ä1¦Ü10Äæ¬O¥Î¤½¦¡=¨ä¥L¤u§@ªíªº¸ê®Æ,¦Ó11Äæ¬O§Ú¥Î¤½¦¡±N²Ä1Ä檺¤é´ÁÂର¦~¥÷¤Î¤ë¥÷,¤è«K²Î­p¾ã¦X¡C

"Type mismatch"
if Arr(i, 11) = YM Then

¯à¤£¯à³Ò·ÐÀ°§Ú¬Ý¤@¤U,ÁÂÁ¡C

TOP

Sub TEST_A1()
Dim Arr, Brr(2), N(2), i&, j%, YM$, SS, S As Worksheet, T$, k%
YM = Format(Date, "yyyy-m")
ReDim Arr(1 To 20000, 1 To 11)
Brr(1) = Arr: Brr(2) = Arr
For Each S In Sheets
    T = UCase(S.Name)
    k = Switch(T Like "QC#*", 1, T Like "CLS-QC#*", 2, T = T, 0)
    If k = 0 Then GoTo s99
    Arr = S.Range("a1").CurrentRegion
    For i = 2 To UBound(Arr)
        If Arr(i, 5) = 0 Then Exit For
        If Arr(i, 11) = YM Then
           N(k) = N(k) + 1
           For j = 1 To UBound(Arr, 2)
               Brr(k)(N(k), j) = Arr(i, j)
           Next j
        End If
    Next i
s99: Next
Set SS = Sheets(Array("QC Summary", "CLS Summary"))
For k = 1 To 2
    SS(k).UsedRange.Offset(1, 0).EntireRow.Delete
    If N(k) > 0 Then SS(k).[a2].Resize(N(k), 11) = Brr(k)
Next k
End Sub

TOP

¦^´_ 1# stephenlee

Report V1.zip (330.61 KB)

TOP

¦^´_ 1# stephenlee
½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, Brr(1 To 10000, 1 To 11), Crr(1 To 10000, 1 To 11)
Dim T$, T1$, n%, n1%, i%, j%, sh
T = Year(Date) & "-" & Month(Date)
For x = 4 To Sheets.Count
    sh = UCase(Left(Sheets(x).Name, 2))
    If InStr(sh, "QC") Then
        With Sheets(x)
            Arr = .Range("a1").CurrentRegion
            For i = 2 To UBound(Arr)
                T1 = Arr(i, 11): If Arr(i, 5) = 0 Then Exit For
                If T = T1 Then n = n + 1: For j = 1 To 11: Brr(n, j) = Arr(i, j): Next
            Next
        End With
    ElseIf InStr(sh, "CL") Then
        With Sheets(x)
            Arr = .Range("a1").CurrentRegion
            For i = 145 To UBound(Arr)
                T1 = Arr(i, 11): If Arr(i, 5) = 0 Then Exit For
                If T = T1 Then n1 = n1 + 1: For j = 1 To 11: Crr(n1, j) = Arr(i, j): Next
            Next
        End With
    End If
Next
If n > 0 Then
    With Sheets("QC Summary")
        .Range("a1").CurrentRegion.Offset(1, 0) = ClearContents
        .[a2].Resize(n, 11) = Brr
    End With
End If
If n1 > 0 Then
    With Sheets("CLS Summary")
        .Range("a1").CurrentRegion.Offset(1, 0) = ClearContents
        .[a2].Resize(n1, 11) = Crr
    End With
End If
End Sub

TOP

        ÀR«ä¦Û¦b : ¯à¥I¥X·R¤ß´N¬OºÖ¡A¯à®ø°£·Ð´o´N¬O¼z¡C
ªð¦^¦Cªí ¤W¤@¥DÃD