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

[µo°Ý] ¸ê®Æ®Mªí

¦^´_ 1# PJChen

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, Brr, i&, C%
Arr = Range([¹w¬ù!o1], [¹w¬ù!a65536].End(3))
Brr = Sheets("»¡©ú").[j1].CurrentRegion
Tm = Timer
For i = 2 To UBound(Arr)
    If UCase(Arr(i, 15)) = "V" Then
        With Sheets("¶ìªO")
            .[c17] = Arr(i, 1): .[e22] = Arr(i, 3): .[c28] = Date
            For j = 2 To UBound(Brr)
                If Arr(i, 2) = Brr(1, j) Then
                .[c16] = Brr(2, j): .[c26] = Brr(3, j): .[c27] = Brr(4, j)
                End If
            Next
        End With
        C = 1: Exit For
    End If
Next
If C = 1 Then
    Application.DisplayAlerts = False
    Sheets("¶ìªO").Copy
    ActiveWorkbook.SaveAs "D:\" & "¨Î-" & Format(Date, "yyyymmdd") & ".xlsx"
    ActiveWindow.Close
    Application.DisplayAlerts = True
    With Sheets("¶ìªO")
        .[c17] = "": .[e22] = "": .[c28] = ""
        .[c16] = "": .[c26] = "": .[c27] = ""
    End With
End If
MsgBox Timer - Tm
End Sub

TOP

¦^´_ 3# PJChen


¤£¦n·N«ä¡A§Ú´ú¸Õ¨S°ÝÃD¡A¥i§_½Ð¦b©ú½T»¡©ú±zªº°ÝÃD­þ¸Ì?
ÁÂÁÂ

TOP

¦^´_ 5# PJChen

¨º¨ì©³­ì¦]¬°¦ó?¦³ªk§ïµ½¶Ü?
>> ¤£¦n·N«ä¡A³y¦¨±zªº§xÂZ¡A§Úªº²Ê¤ß¤j·N¡A¤w§ó·s¦pªþ¥ó¡AÁÂÁÂ
For j = 2 To UBound(Brr, 2)
(Brr,2)¾î¦V(Äæcol)§ä¸ê®Æ
(Brr)ª½¦V(¦Crow)§ä¸ê®Æ

¸ê®Æ®Mªí1001.zip (42 KB)

TOP

¦^´_ 8# PJChen

¦p¦óÅý©Ò¦³"V"
³sÄò°µ®Mªí°Ê§@,ª½¨ì§¹¦¨¡H
>> ½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub test()
Dim Arr, Brr, i&, C%
Tm = Timer
Application.DisplayAlerts = False
Brr = Sheets("»¡©ú").[j1].CurrentRegion
Arr = Range([¹w¬ù!o1], [¹w¬ù!a65536].End(3))
With Sheets("¶ìªO")
    .[c17] = "": .[e22] = "": .[c28] = ""
    .[c16] = "": .[c26] = "": .[c27] = ""
End With
For i = 2 To UBound(Arr)
    If UCase(Arr(i, 15)) = "V" Then
        With Sheets("¶ìªO")
            .[c17] = Arr(i, 1): .[e22] = Arr(i, 3): .[c28] = Date 'Arr(i, 1)=¤é´Á,Arr(i, 3)=¼Æ¶q
            For j = 2 To UBound(Brr, 2)
                If Arr(i, 2) = Brr(1, j) Then
                .[c16] = Brr(2, j): .[c26] = Brr(3, j): .[c27] = Brr(4, j)
                End If
            Next
        End With
        Sheets("¶ìªO").Copy
        ActiveWorkbook.SaveAs "D:\" & Arr(i, 2) & "-" & Format(Arr(i, 1), "yyyymmdd") & ".xlsx"
        ActiveWindow.Close
        With Sheets("¶ìªO")
            .[c17] = "": .[e22] = "": .[c28] = ""
            .[c16] = "": .[c26] = "": .[c27] = ""
        End With
    End If
Next
MsgBox Timer - Tm
Application.DisplayAlerts = True
End Sub

TOP

        ÀR«ä¦Û¦b : ¦³´¼¼z¤~¯à¤À¿ëµ½´c¨¸¥¿¡F¦³Á¾µê¤~¯à«Ø¥ß¬üº¡¤H¥Í¡C
ªð¦^¦Cªí ¤W¤@¥DÃD