เพิ่มความเร็วในการรันข้อมูลของ Macro ได้ไหมครับ

nararat · #1

สวัสดีครับอาจารย์
สืบเนื่องจากกระทู้เก่า
viewtopic.php?p=77256#p77256
ที่อาจารย์ได้สอนไปผมติดปัญหาที่บอกเลยครับ
ถ้าข้อมูลเยอะๆแล้วทำให้ รันข้อมูลได้ช้ามากๆ พอจะมีวิธีทำให้เร็วไหมครับ

Data-New.zip

ผมใส่ Macro ตามนี้ครับ

Code: Select all

Sub Macro1()
' Macro1 Macro
' นับจำนวนกระบวนการทั้งหมดของแต่ละ JOB
    Range("AH10").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-33]=""JOB"",COUNTA(RC[-29]:RC[-1]),"""")"
    Range("AH11").Select
End Sub
Sub Macro2()
' Macro2 Macro
' ดึงข้อมูลจำนวนนับของแต่ละกระบวนการทั้งหมด
    Range("AH10").Select
    Selection.AutoFill Destination:=Range("AH10:AH10000"), Type:=xlFillDefault
    Range("AH10:AH10000").Select
End Sub
Sub Macro3()
' Macro3 Macro
' นับจำนวนแถวต่อแถวทั้งหมดของกระบวนการ
    Range("AI10").Select
    ActiveCell.FormulaR1C1 = "=IF(N(RC[-1]),SUM(R10C[-1]:RC[-1])-RC[-1]+1,"""")"
    Range("AI11").Select
End Sub
Sub Macro4()
' Macro4 Macro
' ดึงข้อมูลของกระบวนการแถวต่อแถวทั้งหมด
    Range("AI10").Select
    Selection.AutoFill Destination:=Range("AI10:AI10000"), Type:=xlFillDefault
    Range("AI10:AI10000").Select
End Sub
Sub Macro5()
' Macro5 Macro
' ดึงเรียง JOB ตามกระบวนการ
    Range("AJ10").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ROWS(R10C:RC)>SUM(C[-2]),"""",INDEX(C[-34],MATCH(ROWS(R10C:RC),C[-1])+1))"
    Range("AJ11").Select
End Sub
Sub Macro6()
' Macro6 Macro
' ดึงข้อมูล JOB ตามกระบวนการทั้งหมด เป็นช่วงๆช่วงละ10000
    Range("AJ10").Select
    Selection.AutoFill Destination:=Range("AJ10:AJ10000"), Type:=xlFillDefault
    Range("AJ10:AJ10000").Select
    Range("AJ10000").Select
    Selection.AutoFill Destination:=Range("AJ10000:AJ20000"), Type:= _
        xlFillDefault
    Range("AJ10000:AJ20000").Select
    Range("AJ20000").Select
    Selection.AutoFill Destination:=Range("AJ20000:AJ30000"), Type:= _
        xlFillDefault
    Range("AJ2000:AJ30000").Select
     Range("AJ30000").Select
    Selection.AutoFill Destination:=Range("AJ30000:AJ40000"), Type:= _
        xlFillDefault
    Range("AJ3000:AJ40000").Select
End Sub
Sub Macro7()
' Macro7 Macro
' เรียกข้อมูลกระบวนการทั้งหมด
    Range("AK10").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]="""","""",INDEX(INDEX(R10C5:R9577C33,MATCH(ROWS(R10C:RC),R10C35:R50000C35),0),COUNTIF(R10C[-1]:RC[-1],RC[-1])))"
    Range("AK11").Select
End Sub
Sub Macro8()
' Macro8 Macro
' ดึงกระบวนการเป็นช่วงๆ ช่วงละ 10000
    Range("AK10").Select
    Selection.AutoFill Destination:=Range("AK10:AK10000"), Type:=xlFillDefault
    Range("AK10:AK10000").Select
    Range("AK10000").Select
    Selection.AutoFill Destination:=Range("AK10000:AK20000"), Type:= _
        xlFillDefault
    Range("AK10000:AK20000").Select
    Range("AK20000").Select
    Selection.AutoFill Destination:=Range("AK20000:AK30000"), Type:= _
        xlFillDefault
    Range("AK20000:AK30000").Select
    Range("AK30000").Select
    Selection.AutoFill Destination:=Range("AK30000:AK40000"), Type:= _
        xlFillDefault
    Range("AK30000:AK40000").Select
End Sub
Sub Macro9()
' Macro9 Macro
' เรียกกระบวนการทั้งหมดมาเรียงใหม่
    Range("D1").Select
    Selection.FormulaArray = _
        "=IFERROR(INDEX(Data!R10C37:R36718C37,SMALL(IF(FREQUENCY(IF(Data!R10C37:R36718C37<>"""",MATCH(Data!R10C37:R36718C37,Data!R10C37:R36718C37,0)),ROW(Data!R10C37:R36718C37)-ROW(Data!R10C37)+1),ROW(Data!R10C37:R36718C37)-ROW(Data!R10C37)+1),COLUMNS(RC4:RC))),"""")"
End Sub
Sub Macro10()
' Macro10 Macro
' ดึงกระบวนการทั้งหมดมาเรียง
    Range("D1").Select
    Selection.AutoFill Destination:=Range("D1:IA1"), Type:=xlFillDefault
    Range("D1:IA1").Select
   ' Range("Z1").Select
    'Selection.AutoFill Destination:=Range("Z1:AZ1"), Type:=xlFillDefault
    'Range("Z1:AZ1").Select
     'Range("AZ1").Select
    'Selection.AutoFill Destination:=Range("AZ1:BZ1"), Type:=xlFillDefault
    'Range("AZ1:BZ1").Select
End Sub
Sub Macro11()
'
' Macro11 Macro
' เรียกข้อมูล JOB กับ JOBCUTNO มาทั้งหมด
'

'
    Range("A2").Select
    Selection.FormulaArray = _
        "=IFERROR(INDEX(Data!R11C[1]:R9577C[1],SMALL(IF(Data!R11C2:R9577C2<>""JOBNO."",ROW(Data!R11C2:R9577C2)-ROW(Data!R11C2)+1),ROWS(R2C:RC))),"""")"
    Selection.AutoFill Destination:=Range("A2:B2"), Type:=xlFillDefault
    Range("A2:B2").Select
End Sub
Sub Macro12()
'
' Macro12 Macro
' เรียก MAINMARK มาแสดง
'

'
    Range("C2").Select
    Selection.FormulaArray = _
        "=IF(RC[-1]<>"""",INDEX(Data!R11C4:R9577C4+0,MATCH(1,IF(Data!R11C2:R69577C2=RC[-2],IF(Data!R11C3:R9577C3=RC[-1],1)),0)),"""")"
End Sub
Sub Macro13()
'
' Macro13 Macro
' เรียกข้อมูลแต่ละ JOB และ แต่ละขั้นตอนมาแสดง
'

'
    Range("D2").Select
    Selection.FormulaArray = _
        "=IF(RC2<>"""",SUMIF(INDEX(Data!R10C5:R9577C33,MATCH(RC1,Data!R10C2:R9577C2,0)-1,0),R1C,INDEX(Data!R11C5:R9577C30,MATCH(1,IF(Data!R11C2:R9577C2=RC1,IF(Data!R11C3:R9577C3=RC2,1)),0),0)),"""")"
End Sub
Sub Macro14()
' Macro14 Macro
' ดึงรวม4กระบวนการ JOBNO JOBCUTNO MAINMARK ยอดของกระบวนการ ทั้งหมด
    Range("A2:D2").Select
    Selection.AutoFill Destination:=Range("A2:D1000"), Type:=xlFillDefault
    Range("A2:D1000").Select
    Range("A1000:D1000").Select
    Selection.AutoFill Destination:=Range("A1000:D2000"), Type:=xlFillDefault
    Range("A1000:D2000").Select
    Range("A2000:D2000").Select
    Selection.AutoFill Destination:=Range("A2000:D3000"), Type:=xlFillDefault
    Range("A2000:D3000").Select
    Range("A3000:D3000").Select
    Selection.AutoFill Destination:=Range("A3000:D4000"), Type:=xlFillDefault
    Range("A3000:D4000").Select
    Range("A4000:D4000").Select
    Selection.AutoFill Destination:=Range("A4000:D5000"), Type:=xlFillDefault
    Range("A4000:D5000").Select
        Range("A5000:D5000").Select
    Selection.AutoFill Destination:=Range("A5000:D6000"), Type:=xlFillDefault
    Range("A5000:D6000").Select
        Range("A6000:D6000").Select
    Selection.AutoFill Destination:=Range("A6000:D7000"), Type:=xlFillDefault
    Range("A6000:D7000").Select
    Range("A7000:D7000").Select
    Selection.AutoFill Destination:=Range("A7000:D8000"), Type:=xlFillDefault
    Range("A7000:D8000").Select
End Sub
Sub Macro15()
'
' Macro15 Macro
' ดึงยอดและข้อมูลต่างๆทั้งหมด
    'Range("D2").Select
    'Range(Selection, Selection.End(xlDown)).Select
    'Selection.AutoFill Destination:=Range("D2:O6420"), Type:=xlFillDefault
    'Range("D2:O6420").Select
 
    'Range("O2").Select
    'Range(Selection, Selection.End(xlDown)).Select
    'Selection.AutoFill Destination:=Range("O2:Z6420"), Type:=xlFillDefault
    'Range("O2:Z6420").Select
    
    'ffffffffffffff
    Range("Z2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFill Destination:=Range("Z2:AP6420"), Type:=xlFillDefault
    Range("Z2:AP6420").Select
    
    Range("AP2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFill Destination:=Range("AP2:BF6420"), Type:=xlFillDefault
    Range("AP2:BF6420").Select
    
    Range("BF2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFill Destination:=Range("BF2:BW6420"), Type:=xlFillDefault
    Range("BF2:BW6420").Select
    
    Range("BW2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFill Destination:=Range("BW2:CM6420"), Type:=xlFillDefault
    Range("BW2:CM6420").Select
    
    Range("CM2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFill Destination:=Range("CM2:GA6420"), Type:=xlFillDefault
    Range("CM2:GA6420").Select
End Sub

snasui · #2

ไฟล์ทีแนบมาไม่มี Code ช่วยแนบไฟล์ที่มี Code มาด้วยเพื่อน ๆ จะได้สะดวกในการทดสอบครับ

จากการดู Code ผมขอตอบเร็ว ๆ เพื่อเป็นแนวทางก่อนครับ

Code ที่เขียนมาไม่สามารถทำให้เร็วไปกว่าเดิมได้เพราะเป็นการแปลงสูตรที่เขียนด้วยมือให้กลายเป็นสูตรเขียนด้วยโปรแกรม การจะให้เร็วจะต้องไม่มีสูตรอยู่ในตารางเป้าหมาย หากจะใช้สูตรก็เพียงเพื่อให้ได้ข้อมูลที่ต้องการแล้วนำค่าไปวาง ไม่ใช่นำสูตรไปวางครับ

การลักษณะนี้ควรจะ Loop ด้วย Code เป็นหลักค่อย ๆ ศึกษาไปครับ

snasui · #3

ตัวอย่าง Code ตามด้านล่าง ซึ่งเข้าใจยากมากสำหรับมือใหม่ เพราะใช้ทั้ง Array และ Scripting.Dictionary ลองค่อย ๆ ศึกษาดูครับ

Code: Select all

Dim rc1 As Range, rc As Range
Dim rh As Range, r As Range, d As Object
Dim rdall As Range, rd As Range, l As Integer
Dim arrData(0 To 59999, 0 To 255) As Variant
Dim i As Integer, j As Integer, k As Integer

On Error Resume Next
Set d = CreateObject("Scripting.Dictionary")
i = 0
With Sheets("Data")
    Set rc1 = .UsedRange.Columns(1).Cells
    For Each rc In rc1
        If rc.Value = "JOB" Then
            Set rh = .Range(rc, .Cells(rc.Row, .Columns.Count).End(xlToLeft))
            For Each r In rh
                If Not d.exists(r.Value) Then
                    d.Add Key:=r.Value, Item:=r.Value
                    arrData(0, i) = r.Value
                    i = i + 1
                End If
            Next r
        Else
            j = j + 1
            k = 0
            Set rdall = .Range(rc, .Cells(rc.Row, .Columns.Count).End(xlToLeft))
            For Each rd In rdall
                If k <= 3 Then
                    arrData(j, k) = rd.Value
                Else
                    l = Application.Match(rh(k + 1), d.keys, 0) - 1
                    arrData(j, l) = arrData(j, l) + rd.Value
                End If
                k = k + 1
            Next rd
        End If
    Next rc
End With
With Sheets("Sheet2")
    .UsedRange.ClearContents
    .Range("a1").Resize(j + 1, i + 1).Value = arrData
End With
MsgBox "Finished.", vbInformation

Excel Forum

EXCEL TOOLS

เพิ่มความเร็วในการรันข้อมูลของ Macro ได้ไหมครับ

เพิ่มความเร็วในการรันข้อมูลของ Macro ได้ไหมครับ

Re: เพิ่มความเร็วในการรันข้อมูลของ Macro ได้ไหมครับ

Re: เพิ่มความเร็วในการรันข้อมูลของ Macro ได้ไหมครับ