: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 7 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