สอบถามเรื่องการ ru marco

[March201711]

มีปัญหาการ run macro แล้วรันช้ามาก คือ ไม่ได้เขียนเอง แต่ใช้เวลาการ record marco คะ บางครั้ง runแล้ว เครื่อง error ไม่สามารถใช้ excel ต่อได้เลย ต้องกด ctrl+alt+del ทุกครั้ง excel จะปิดการทำงานของ files ทั้งหมด ซึ่งใน file จะมี 2 ปุ่มให้กด 1.clear ข้อมูล 2.run rate แบงชาติทุกวัน ต้องทำอย่างไรคะให้รันเร็วขึ้น ไม่แน่ใจว่าดึงข้อมูลจาก web ทำให้ช้าไปหรือเปล่าหรือใช้การ record marco ที่เยอะเกินไปคะ

[snasui]

Macro ที่บันทึกไว้จะเป็นการ Add QueryTable เข้าไปทุกครั้งที่คลิก จะเกิด Connection เพิ่มขึ้นเรื่อย ๆ ปกติ Connection เราจะสร้างครั้งแรกเท่านั้นหลังจากนั้นจะเป็นการ Refresh เพื่อดึงข้อมูลที่ Update มาวางใหม่

ให้สร้าง Connection ไว้สักครั้งก่อน จากนั้นค่อยใช้ Macro Refresh QueryTable และจัดการงานที่เหลือเท่านั้น ไม่ต้องสร้าง Connection ซ้ำ ๆ อีกครับ

ตัวอย่างการปรับ Code ตามด้านล่างให้เป็นการ Refresh และจัดการงานที่เหลือครับ

Code: Select all

Sub BOT()
'
' BOT Macro
'

'
'    With ActiveSheet.QueryTables.Add(Connection:= _
'        "URL;https://www.bot.or.th/English/Statistics/FinancialMarkets/ExchangeRate/_layouts/Application/ExchangeRate/ExchangeRate.aspx" _
'        , Destination:=Range("$Z$200"))
'        .Name = "ExchangeRate"
'        .FieldNames = True
'        .RowNumbers = False
'        .FillAdjacentFormulas = False
'        .PreserveFormatting = True
'        .RefreshOnFileOpen = False
'        .BackgroundQuery = True
'        .RefreshStyle = xlInsertDeleteCells
'        .SavePassword = False
'        .SaveData = True
'        .AdjustColumnWidth = True
'        .RefreshPeriod = 0
'        .WebSelectionType = xlEntirePage
'        .WebFormatting = xlWebFormattingNone
'        .WebPreFormattedTextToColumns = True
'        .WebConsecutiveDelimitersAsOne = True
'        .WebSingleBlockTextImport = False
'        .WebDisableDateRecognition = False
'        .WebDisableRedirections = False
'        .Refresh BackgroundQuery:=False
'    End With
'    ActiveWindow.SmallScroll Down:=84
'    ActiveWindow.LargeScroll Down:=8
    With ActiveSheet
        DoEvents
        .Range("z200").QueryTable.Refresh False
    End With
    Range("A1:E1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("A2:E2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("A2").Select
    Cells.Find(What:="Foreign Exchange Rates as ", After:=ActiveCell, LookIn _
        :=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Cells.Find(What:="Baht/US Dollar", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    Range("A350").Select
    ActiveSheet.Paste
    Range("A2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=""Weighted-average interbank Exchange Rate ="" & TEXT(R[348]C,""##.###"")"
    Range("A3").Select
    Application.Goto Reference:="R350C1"
    Application.Goto Reference:="R1C1"
    Range("A1:A2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1:E1").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("A2:E2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("C13").Select
    Application.Goto Reference:="R350C1"
    Selection.ClearContents
    Range("C8").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],C28:C31,2,FALSE)"
    Range("C8").Select
    ActiveWindow.SmallScroll Down:=-9
    Selection.AutoFill Destination:=Range("C8:C26")
    Range("C8:C26").Select
    Range("D8").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],C28:C31,3,FALSE)"
    Range("D8").Select
    Selection.AutoFill Destination:=Range("D8:D26")
    Range("D8:D26").Select
    Range("E8").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],C28:C31,4,FALSE)"
    Range("E8").Select
    Selection.AutoFill Destination:=Range("E8:E26")
    Range("E8:E26").Select
    Range("C8").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.Goto Reference:="R200C26"
    Columns("Z:AE").Select
    Range("Z200").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A8").Select
    MsgBox "Finished", vbInformation
End Sub

[March201711]

ขอบคุณมากคะ อาจารย์

[March201711]

สงสัยค่ะ ทำไม formula เลือกข้อมูลให้เองทำให้ file ข้อมูลเพิ่มขึ้นเรื่อยๆคะ แนบไฟล์ไปแล้วไม่ผ่านคะ เพราะไหล์มีขนาดใหญ่ 5-6 mb คะ

[snasui]

ลองกดแป้น Ctrl+End เพื่อดู Last Cell ว่าอยู่ตำแหน่งใด ก่อนหน้าเซลล์นั้นทั้งในแนวคอลัมน์และแนวบรรทัดมีข้อมูลอยู่หรือไม่ หากไม่มีให้ลบบรรทัดว่าง ลบคอลัมน์ว่างทิ้งไปเสียก่อน อย่าลืมตรวจสอบว่าจะต้องไม่ลบเซลล์ที่ใช้วาง Query Table ครับ

[March201711]

ดูแล้วไม่มีข้อความเลย แต่ไม่เป็นไรค่ะ สร้างไฟล์ใหม่จะลองหาวิธีอื่นดู ขอบคุณอาจารย์ค่ะ

[logic]

ดูแล้วไม่มีข้อความเลย แต่ไม่เป็นไรค่ะ สร้างไฟล์ใหม่จะลองหาวิธีอื่นดู ขอบคุณอาจารย์ค่ะ

ไม่มีข้อความเลยก็ให้ลบคอล้มน์ว่างก่อนเซลล์นั้น บรรทัดว่างก่อนเซลล์นั้นตามที่อาจารย์แจ้งไป พอลบแล้ว Save ไปเสียครั้งหนึ่ง จากนั้นทดสอบปิดและเปิดไฟล์อีกที ลองสังเกตว่ายังเป็นอยู่ไหมครับ

[March201711]

OK ค่ะ จะลองทำดู ขอบคุณค่ะ