[µo°Ý] ¿z¿ï¬ÛÃöªº¼Æ¾Ú

doulioufire

¦U¦ì°ª¤â¡A¦p¹Ï¤ù¡]¹Ï¤@¡^©Òªí¥Ü¡A·íPM2.5¤j©ó36ªº®É­Ô¡A­·¦Vªº¼Æ¾Ú·|¦Û°Ê¶]¨ì¥t¤@­Óªí³æ¡]¦p¹Ï¤G¡^

¤U¸ü (55.34 KB)

2015-12-22 10:54

¤U¸ü (28.55 KB)
¹Ï¤G

2015-12-22 11:00

doulioufire

¦^´_ 8# yen956


    ¤Ó¥Î¤F¤ß¤F¡A·PÁ°ª¤âªº¨ó§U

yen956

¹ï¤£°_, ¦]¦Ò¼{¨ì§A¥i¯à»Ý­n ®É¶¡,
´ú¸Õ®É¦³µyµy­×§ïªí®æ, §Ñ¤F§ï¦^¨Ó,
ªí®æ¤w§ï¦^¨Ó¤F, ¤]¤w­«·s­×¥¿VBA,
¥u¼W¥[®É¶¡¦Ó¤v, ¨ä¥L¤£ÅÜ, ¸Õ¸Õ¬Ý!!

1. Private Sub CommandButton1_Click()
   
2.     Dim sh1 As Worksheet
   
3.     Dim c0 As Long, r0 As Long, LstR0 As Long, cnt As Integer
   
4.     Dim c1 As Long, r1 As Long, LstR1 As Long, msg As Integer
   
5.     Set sh1 = Sheets("¤u§@ªí1")
   
6.     msg = MsgBox("­n²M°£ [¤u§@ªí1] ¤¤­ì¦³¸ê®Æ¶Ü?", vbYesNo)
   
7.     If msg = vbYes Then
   
8.         sh1.Cells.Clear
   
9.         [A1].Copy sh1.[A1]
   
10.     End If
    
11.     LstR0 = Cells(Rows.Count, "B").End(xlUp).Row
    
12.     LstR1 = sh1.Cells(Rows.Count, "B").End(xlUp).Row
    
13.     For r0 = Int(LstR1 / 5) * 6 + 2 To LstR0 Step 6
    
14.         r1 = Int(r0 / 6) * 5 + 2
    
15.         Cells(r0, 1).Resize(4, 2).Copy sh1.Cells(r1, 1)
    
16.         cnt = 2
    
17.         For c0 = 3 To 26
    
18.             If Cells(r0, c0) >= 36 Then
    
19.                 cnt = cnt + 1
    
20.                 Cells(1, c0).Copy sh1.Cells(r1 - 1, cnt)
    
21.                 Cells(r0, c0).Resize(4, 1).Copy sh1.Cells(r1, cnt)
    
22.             End If
    
23.         Next
    
24.     Next
    
25. End Sub

½Æ»s¥N½X

°õ¦æµ²ªG¦p¤U:

¤U¸ü (142.52 KB)

2015-12-22 17:30

doulioufire

¦^´_ 4# yen956


    ·PÁ¡AÁÙ»s§@°Êµe¡A«¢«¢¡A¦b¤@¦¸ªº·PÁÂ

doulioufire

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


    ³o¯u¬O¤Ó¯«¤F¡A·PÁÂ

doulioufire

¦^´_ 2# hcm19522


    ·PÁ°ª¤âªº¦^µª¡A§Ú¦b¹Á¸Õ¬Ý¬Ý¡I

yen956

¸Õ¸Õ¬Ý:

1. Private Sub CommandButton1_Click()
   
2.     Dim sh1 As Worksheet
   
3.     Dim c0 As Long, r0 As Long, LstR0 As Long, cnt As Integer
   
4.     Dim c1 As Long, r1 As Long, LstR1 As Long, msg As Integer
   
5.     Set sh1 = Sheets("¤u§@ªí1")
   
6.     LstR0 = Cells(Rows.Count, "B").End(xlUp).Row
   
7.     LstR1 = sh1.Cells(Rows.Count, "B").End(xlUp).Row
   
8.     If LstR0 - 2 = LstR1 Then
   
9.         msg = MsgBox("¤u§@ªí1¤¤, " & Cells(LstR0 - 5, "A") & " ªº¸ê®Æ¤w¸g¦s¦b, ­nÂл\¶Ü?", vbOKCancel)
   
10.         If msg = vbCancel Then Exit Sub
    
11.     End If
    
12.     For r0 = LstR1 + 3 To LstR0 Step 6
    
13.         Cells(r0, 1).Resize(4, 2).Copy sh1.Cells(r0, 1)
    
14.         cnt = 2
    
15.         For c0 = 3 To 26
    
16.             If Cells(r0, c0) >= 36 Then
    
17.                 cnt = cnt + 1
    
18.                 sh1.Cells(r0 - 1, cnt) = Cells(1, c0)
    
19.                 sh1.Cells(r0 - 1, cnt) = Format(sh1.Cells(r0 - 1, cnt), "hh:mm;@")
    
20.                 Cells(r0, c0).Resize(4, 1).Copy sh1.Cells(r0, cnt)
    
21.             End If
    
22.         Next
    
23.     Next
    
24. End Sub

½Æ»s¥N½X

¤U¸ü (326.09 KB)

2015-12-22 16:03

­ã´£³¡ªL

Sub TEST1()
Dim xR As Range, xH As Range, xU As Range, j&
Sheets("¤u§@ªí1").UsedRange.Clear
Set xH = [¤u§@ªí1!A2]
[¹Å¸q!A1].Copy xH(0)
For Each xR In Range([¹Å¸q!A2], [¹Å¸q!A65536].End(xlUp))
¡@¡@If xR.Row = 1 Then Exit Sub
¡@¡@If xR = "" Then GoTo 101
¡@¡@Set xU = xR.Resize(6, 2)
¡@¡@For j = [C1].Column To [Z1].Column
¡@¡@¡@¡@If xR(1, j) >= 36 Then Set xU = Union(xU, xR(1, j).Resize(6))
¡@¡@Next j
¡@¡@xU.Copy xH
¡@¡@Set xH = xH(8)
101: Next
End Sub¡@

hcm19522

C2:R20{=IFERROR(IF(MOD(ROW(A1),5)=0,"",OFFSET(¹Å¸q!$A$1,INT((ROW(A1)-1)/5)*6+MOD(ROW(A1),5),SMALL(IF(OFFSET(¹Å¸q!$C$2,MAX(INT(ROW(A1)/5)*6),,,24)>=36,COLUMN($C:$Z)),COLUMN(A1))-1)),"")