:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser

จะกำหนด VBA ให้จบที่ชี้ตใดเซลล์ใดก็ได้ ทำอย่างไร

ฟอรัมถาม-ตอบปัญหาการใช้งาน Macro และ VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
godman
Silver
Silver
Posts: 643
Joined: Mon Jul 05, 2010 6:18 pm

จะกำหนด VBA ให้จบที่ชี้ตใดเซลล์ใดก็ได้ ทำอย่างไร

#1

Post by godman »

สวัสดีครับอาจารย์
พอดีว่า ผมได้สร้างโค้ดขึ้นมาโดยนำมาจากที่อื่นแล้วความต้องการของผมคือให้มันไปสุดท้ายที่ชี้ต ชื่อ firstpage เซลล์ H5 ผมก็เขียนโค้ดเพิ่มเติมตรงท้ายสุดว่า
Sub GOTO....
....ตามโค้ดที่ผมแนบมา แต่ปรากฏว่าพอรันแล้วมันยังจบอยู่ที่ชี้ต pivottable อยู่ ผมไม่รู้จะต้องเปลี่ยนที่ตรงใหนมันจึงจะไปจบที่ชี้ตดังกล่าวได้ครับ

Code: Select all

Dim iRow
Dim Counter
Dim myFile As Scripting.File

Sub ListFiles()
    On Error Resume Next
    Call Setup
    Call ListMyFiles(Range("Folder"), Range("Include_Subfolders"))
    Call SortRange
    Call HideUnwantedCols
    Call DisplayOrder
    Call RefreshPivot
End Sub


Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Dim MyObject As Scripting.FileSystemObject
    
    On Error Resume Next
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    
    For Each myFile In mySource.Files
        Counter = 1
        For i = 1 To 11
            Call GetAttribute(i)
        Next
        If iRow > Range("Stop_After") Then Exit Sub
        Application.StatusBar = "File Number: " & iRow
        iRow = iRow + 1
    Next
    If IncludeSubfolders Then
        For Each mySubFolder In mySource.SubFolders
            Call ListMyFiles(mySubFolder.Path, True)
        Next
    End If
End Sub

Sub Setup()
    Sheets("Files").Select
    Cells.ClearContents
    Cells.EntireColumn.Hidden = False
    iCol = 1
    iRow = 2
    Cells(1, iCol) = "Attributes"
    iCol = iCol + 1
    Cells(1, iCol) = "DateCreated"
    iCol = iCol + 1
    Cells(1, iCol) = "DateLastAccessed"
    iCol = iCol + 1
    Cells(1, iCol) = "DateLastModified"
    iCol = iCol + 1
    Cells(1, iCol) = "Drive"
    iCol = iCol + 1
    Cells(1, iCol) = "Name"
    iCol = iCol + 1
    Cells(1, iCol) = "ParentFolder"
    iCol = iCol + 1
    Cells(1, iCol) = "Path"
    iCol = iCol + 1
    Cells(1, iCol) = "ShortName"
    iCol = iCol + 1
    Cells(1, iCol) = "Size"
    iCol = iCol + 1
    Cells(1, iCol) = "Type"

    For iCol = 1 To 11
        Columns(iCol).NumberFormat = Range("Format").Offset(iCol).NumberFormat
    Next

End Sub

Function GetAttribute(AttributeNumber)
        If Range("What_To_Show").Offset(Counter, 0).Font.Bold = True Then
            Select Case AttributeNumber
                Case 1
                    Cells(iRow, Counter).Value = myFile.Attributes
                Case 2
                    Cells(iRow, Counter).Value = myFile.DateCreated
                Case 3
                    Cells(iRow, Counter).Value = myFile.DateLastAccessed
                Case 4
                    Cells(iRow, Counter).Value = myFile.DateLastModified
                Case 5
                    Cells(iRow, Counter).Value = myFile.Drive
                Case 6
                    Cells(iRow, Counter).Value = myFile.Name
                Case 7
                    Cells(iRow, Counter).Value = myFile.ParentFolder
                Case 8
                    Cells(iRow, Counter).Value = myFile.Path
                Case 9
                    Cells(iRow, Counter).Value = myFile.ShortName
                Case 10
                    Cells(iRow, Counter).Value = myFile.Size
                Case 11
                    Cells(iRow, Counter).Value = myFile.Type
            End Select
        End If
        Counter = Counter + 1
End Function

Sub SortRange()
    With ActiveWorkbook.Worksheets("Files").Sort
        .SortFields.Clear
        For i = 1 To 11
        Set rngFoundIt = Sheets("Main").Columns(Range("Sort_Order").Column).Find(i, LookIn:=xlValues, LookAt:=xlWhole)
            If Not rngFoundIt Is Nothing Then
                .SortFields.Add Key:=Cells(2, rngFoundIt.Row - Range("Sort_Order").Row), _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End If
        Next
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Cells.EntireColumn.AutoFit
End Sub

Sub DisplayOrder()

End Sub

Sub HideUnwantedCols()
    For i = 1 To 11
        If Range("What_To_Show").Offset(i, 0).Font.Bold = False Then
            Sheets("files").Columns(i).Hidden = True
        End If
    Next
End Sub

Sub RefreshPivot()
    Sheets("pivot").Select
    ActiveSheet.PivotTables(1).PivotCache.Refresh
End Sub
Sub GotoFirstPage()
    Sheet("FirstPage").Select
    Range("h5").Select

End Sub

Attachments
Program list all file Test.zip
Filetest
(114.51 KiB) Downloaded 10 times
joo
Gold
Gold
Posts: 1213
Joined: Sat Apr 17, 2010 3:50 pm

Re: จะกำหนด VBA ให้จบที่ชี้ตใดเซลล์ใดก็ได้ ทำอย่างไร

#2

Post by joo »

:D ลองแบบนี้ดูครับ
ที่ Sub ListFiles() เพิ่มบรรทัดนี้เข้าไป

Code: Select all

Call GotoFirstPage

และที่

Code: Select all

Sub GotoFirstPage()
    Sheet("FirstPage").Select
    Range("h5").Select
End Sub
ปรับแก้ไขเป็น

Code: Select all

Sub GotoFirstPage()
    Sheets("FirstPage").Select
    Range("h5").Select
End Sub
หรือที่ ที่ Sub ListFiles() เพิ่มบรรทัดนี้เข้าไป

Code: Select all

Sheets("FirstPage").Select
    Range("h5").Select
godman
Silver
Silver
Posts: 643
Joined: Mon Jul 05, 2010 6:18 pm

Re: จะกำหนด VBA ให้จบที่ชี้ตใดเซลล์ใดก็ได้ ทำอย่างไร

#3

Post by godman »

ขอบคุณมาก คุณ จู ผมทำได้แล้ว
Post Reply