Snasui Excel Forum

คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
https://www.snasui.com/

VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

https://www.snasui.com/viewtopic.php?t=9908

Page 1 of 1

VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Thu Mar 31, 2016 12:55 am
by aueijung
Module11 ใช้โค๊ดดังนี้ครับอาจารย์

Code: Select all

Sub Grade0_Click()
Dim directory As String, fileName As String
Dim sheet As Worksheet, j As Integer, i, k, l, m, n, o, w As Integer
Dim tempBook As Workbook, thsBook As Workbook
    Application.ScreenUpdating = False      'directory = "D:\»¾.5\»Õ¡ÒÃÈÖ¡ÉÒ2559\ÁѸÂÁ\à·ÍÁ1\Á.1-1\"
    directory = Sheets("Main").Range("B1").Value
    fileName = Dir(directory & "*.xl??")
    Set thsBook = ThisWorkbook
    w = 7
    j = 7
    i = 8
    k = 2
    l = 3
    m = 4
    n = 5
    o = 6
    Do While fileName <> ""
       Set tempBook = Workbooks.Open(directory & fileName)
     '  thsBook.Sheets("เกรด0").Cells(2, j) = tempBook.Name
     If (tempBook.Sheets("คะแนน1").Range("BA" & i).Value) = 0 Then
      thsBook.Worksheets("เกรด0").Cells(w, j).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("BA" & i).Value
       thsBook.Worksheets("เกรด0").Cells(w, k).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("B" & i).Value
       thsBook.Worksheets("เกรด0").Cells(w, l).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("C" & i).Value
       thsBook.Worksheets("เกรด0").Cells(w, m).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("D" & i).Value
       thsBook.Worksheets("เกรด0").Cells(w, n).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("E" & i).Value
       thsBook.Worksheets("เกรด0").Cells(w, o).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("AZ" & i).Value
      ' ´Ö§ÁÒ¨Ò¡ªÕ· Home
       thsBook.Worksheets("เกรด0").Cells(w, 8).Resize(1, 1).Value = tempBook.Sheets("Home").Range("G5").Value
       thsBook.Worksheets("เกรด0").Cells(w, 9).Resize(1, 1).Value = tempBook.Sheets("Home").Range("G4").Value
       thsBook.Worksheets("เกรด0").Cells(w, 10).Resize(1, 1).Value = tempBook.Sheets("Home").Range("C11").Value
       thsBook.Worksheets("เกรด0").Cells(w, 11).Resize(1, 1).Value = tempBook.Sheets("Home").Range("C12").Value
       thsBook.Worksheets("เกรด0").Cells(w, 12).Resize(1, 1).Value = tempBook.Sheets("Home").Range("D13").Value
       thsBook.Worksheets("เกรด0").Cells(w, 13).Resize(1, 1).Value = tempBook.Sheets("Home").Range("E9").Value
       thsBook.Worksheets("เกรด0").Cells(w, 14).Resize(1, 1).Value = tempBook.Sheets("Home").Range("C17").Value
       
        End If
        i = i + 1
       ' k = k + 1
       ' l = l + 1
       ' m = m + 1
       ' n = n + 1
       ' o = o + 1
        w = w + 1
        j = j + 1
        tempBook.Close False
        fileName = Dir()
    Loop
    Application.ScreenUpdating = True
   ' MsgBox ("ÃѺ¢éÍÁÙŨҡ Directory " & Sheets("¤Ðá¹¹1").Range("B1").Value & " àÃÕºÃéÍÂáÅéǤÃѺ")
End Sub
เรียนสอบถามครับอาจารย์ ในแต่ละไฟล์ของโฟลเดอร์ D:\ปพ.5\ปีการศึกษา2559\มัธยม\เทอม1\ม.1-1\ มีไฟล์บรรจุอยู่หลายไฟล์ เมื่อเปิดดูแต่ละไฟล์ ถ้าพบว่านักเรียนได้เกรด 0 ที่ชีท คะแนน1 cell BA8:BA62 ของแต่ละไฟล์ ถ้าติด 0 ก็ให้คัดลอกข้อมูลมาแสดงเฉพาะคนที่ติด 0 จนครบทุกคนที่ติด ทุกรายวิชา คัดลอกมาวางลงที่ ไฟล์ รศ.2-มัธยมต้น.xlsm ที่ชีท เกรด0 cell B7:N7 ถ้าพบคนติด 0 ก็วางลงไปในแถวถัดมาคือ B8:N8 ไปเรื่อยๆ จนไม่มีคนติด 0 ก็ให้จบการทำงาน
เรียนสอบถามอาจารย์ว่า ผมจะแก้ปัญหาตรงจุดใดครับ
ใช้ปุ่ม แสดงนักเรียนที่ได้เกรด 0 ที่ชีท เกรด0

Re: VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Thu Mar 31, 2016 9:42 pm
by snasui
:D ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub Grade0_Click()
    Dim directory As String, fileName As String
    Dim sheet As Worksheet, j As Integer, i, k, l, m, n, o, w As Integer
    Dim tempBook As Workbook, thsBook As Workbook
    Application.ScreenUpdating = False      'directory = "D:\ปพ.5\ปีการศึกษา2559\มัธยม\เทอม1\ม.1-1\"
    directory = Sheets("Main").Range("B1").Value
    fileName = Dir(directory & "*.xl??")
    Set thsBook = ThisWorkbook
        w = 7
        j = 7
'        i = 8
        k = 2
        l = 3
        m = 4
        n = 5
        o = 6
    Do While fileName <> ""
       Set tempBook = Workbooks.Open(directory & fileName)
     '  thsBook.Sheets("เกรด0").Cells(2, j) = tempBook.Name
        i = 8
        Do While tempBook.Sheets("คะแนน1").Range("B" & i) <> ""
           If (tempBook.Sheets("คะแนน1").Range("BA" & i).Value) = 0 Then
                thsBook.Worksheets("เกรด0").Cells(w, j).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("BA" & i).Value
                 thsBook.Worksheets("เกรด0").Cells(w, k).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("B" & i).Value
                 thsBook.Worksheets("เกรด0").Cells(w, l).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("C" & i).Value
                 thsBook.Worksheets("เกรด0").Cells(w, m).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("D" & i).Value
                 thsBook.Worksheets("เกรด0").Cells(w, n).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("E" & i).Value
                 thsBook.Worksheets("เกรด0").Cells(w, o).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("AZ" & i).Value
                ' ดึงมาจากชีท Home
                 thsBook.Worksheets("เกรด0").Cells(w, 8).Resize(1, 1).Value = tempBook.Sheets("Home").Range("G5").Value
                 thsBook.Worksheets("เกรด0").Cells(w, 9).Resize(1, 1).Value = tempBook.Sheets("Home").Range("G4").Value
                 thsBook.Worksheets("เกรด0").Cells(w, 10).Resize(1, 1).Value = tempBook.Sheets("Home").Range("C11").Value
                 thsBook.Worksheets("เกรด0").Cells(w, 11).Resize(1, 1).Value = tempBook.Sheets("Home").Range("C12").Value
                 thsBook.Worksheets("เกรด0").Cells(w, 12).Resize(1, 1).Value = tempBook.Sheets("Home").Range("D13").Value
                 thsBook.Worksheets("เกรด0").Cells(w, 13).Resize(1, 1).Value = tempBook.Sheets("Home").Range("E9").Value
                 thsBook.Worksheets("เกรด0").Cells(w, 14).Resize(1, 1).Value = tempBook.Sheets("Home").Range("C17").Value
                w = w + 1
              End If
              i = i + 1
              'k = k + 1
             ' l = l + 1
              'm = m + 1
             ' n = n + 1
             ' o = o + 1
              'w = w + 1
              j = j + 1
           Loop
        tempBook.Close False
        fileName = Dir()
    Loop
    Application.ScreenUpdating = True
   ' MsgBox ("รับข้อมูลจาก Directory " & Sheets("คะแนน1").Range("B1").Value & " เรียบร้อยแล้วครับ")
End Sub

Re: VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Thu Mar 31, 2016 10:27 pm
by aueijung
ใช้ได้แล้วครับอาจารย์ งงอยู่ตั้งนาน ขอบพระคุณมากครับผม

Re: VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Thu Mar 31, 2016 10:34 pm
by DhitiBank
ขอเอาไฟล์ไปศึกษานะครับ มีคำสั่งหลายอย่างน่าสนใจ

สงสัยว่า DIR(...,&H1F) option นี้ในคำสั่ง Dir หมายถึงอะไรครับ ลองค้นหาแล้ว ไม่เห็นมีเลย

Re: VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Thu Mar 31, 2016 10:35 pm
by snasui
:D หากหมายถึง fileName = Dir() เป็นคำสั่งให้ไปยังไฟล์ต่อไปครับ

สำหรับ Dir ศึกษาเพิ่มเติมได้ที่นี่ครับ Dir Function, Loop Files, File in Directory

Re: VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Thu Mar 31, 2016 10:57 pm
by aueijung
:roll: เรียนสอบถามเพิ่มเติมครับ เหตุใดไฟล์ รศ.2-มัธยมต้น.xlsm sheet เกรด0 cell G7 แสดงค่า 0 แค่คนเดียว G8 : G* ลำดับถัดไป ไม่แสดงค่า 0 ครับ ถ้าจะแก้ต้องปรับส่วนใดครับ
และถ้าในแต่ละไฟล์ที่ดึงข้อมูลมา ไม่มีนักเรียน หรือ นักเรียนออกไปแล้ว sheet คะแนน1 ที่ cell BA8:BA62 จะมีค่าว่าง คือ ไม่มีคะแนน จะไม่เป็น 0 แต่จะเป็น " " ในตำแหน่งดังกล่าว จะทำอย่างไรให้ข้าม ตำแหน่งไปดึงค่าแต่เฉพาะคนที่ได้ 0 จริงๆ ครับ เรียนสอบถามครับ

Re: VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Thu Mar 31, 2016 11:00 pm
by aueijung
:mrgreen: นำไฟล์ไปศึกษาได้เลยครับ คุณDhitiBank ^^ ยินดีครับผม

Re: VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Thu Mar 31, 2016 11:08 pm
by snasui
aueijung wrote: :roll: เรียนสอบถามเพิ่มเติมครับ เหตุใดไฟล์ รศ.2-มัธยมต้น.xlsm sheet เกรด0 cell G7 แสดงค่า 0 แค่คนเดียว G8 : G* ลำดับถัดไป ไม่แสดงค่า 0 ครับ ถ้าจะแก้ต้องปรับส่วนใดครับ
และถ้าในแต่ละไฟล์ที่ดึงข้อมูลมา ไม่มีนักเรียน หรือ นักเรียนออกไปแล้ว sheet คะแนน1 ที่ cell BA8:BA62 จะมีค่าว่าง คือ ไม่มีคะแนน จะไม่เป็น 0 แต่จะเป็น " " ในตำแหน่งดังกล่าว จะทำอย่างไรให้ข้าม ตำแหน่งไปดึงค่าแต่เฉพาะคนที่ได้ 0 จริงๆ ครับ เรียนสอบถามครับ
:D ลองศึกษาและปรับมาเองก่อนเสมอ ติดแล้วค่อยถามครับ

Re: VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Thu Mar 31, 2016 11:27 pm
by DhitiBank
snasui wrote::D หากหมายถึง fileName = Dir() เป็นคำสั่งให้ไปยังไฟล์ต่อไปครับ

สำหรับ Dir ศึกษาเพิ่มเติมได้ที่นี่ครับ Dir Function, Loop Files, File in Directory
ขอบคุณอาจารย์มากครับ :)
แต่ที่สงสัยไม่ใช่บรรทัดนั้นครับ ตอนนี้ผมไม่มีคอมฯ ไม่แน่ใจว่าจำถูกไหม รู้สึกว่าคำสั่งจะอยู่ในโพรซีเยอร์ชื่อ Listfile อะไรสักอย่าง มีบรรทัดหนึ่งที่มีคำสั่ง DIR ตรงที่เป็นค่า attribute แทนที่จะเป็นเลข หรือเป็นคำสั่งเช่น ,vbdirectory, ,vbhidden ฯลฯ กลับเป็น ,&H1F แทน (ขออภัยหากจำผิดครับ)

ไม่เข้าใจว่า ,&H1F มันมีความหมายอะไร ลองหาในเน็ตก็มีคนใช้แบบนี้ด้วย แต่หาคำอธิบายไม่เจอครับ

Re: VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Fri Apr 01, 2016 12:04 am
by snasui
:D เป็นการใช้ Hex Value แทนการคีย์ตัวเลขเข้าไปตรงๆ ครับ

ดูเพิ่มเติมที่นี่ครับ Hex Value

เราสามารถดูค่าตัวเลขของ Hex Value ได้โดยเปิด Immediate Windows แล้วคีย์

?&H1F

Enter

Re: VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Fri Apr 01, 2016 7:28 am
by DhitiBank
snasui wrote::D เป็นการใช้ Hex Value แทนการคีย์ตัวเลขเข้าไปตรงๆ ครับ

ดูเพิ่มเติมที่นี่ครับ Hex Value

เราสามารถดูค่าตัวเลขของ Hex Value ได้โดยเปิด Immediate Windows แล้วคีย์

?&H1F

Enter
:o แบบนี้นี่เอง ขอบคุณครับ

Re: VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Sun Apr 03, 2016 7:40 pm
by aueijung
:mrgreen: 0 ปรากฏแล้วครับ จากโค๊ดด้านล่างนี้ครับ

Code: Select all

Sub Grade0_Click()
Dim directory As String, fileName As String
Dim sheet As Worksheet, j As Integer, i, k, l, m, n, o, w As Integer
Dim tempBook As Workbook, thsBook As Workbook
    Application.ScreenUpdating = False      'directory = "D:\ปพ.5\ปีการศึกษา2559\มัธยม\เทอม1\ม.1-1\"
    directory = Sheets("Main").Range("B1").Value
    fileName = Dir(directory & "*.xl??")
    Set thsBook = ThisWorkbook
    w = 7
    j = 7

    k = 2
    l = 3
    m = 4
    n = 5
    o = 6
    Do While fileName <> ""
       Set tempBook = Workbooks.Open(directory & fileName)
      ' thsBook.Sheets("เกรด0").Cells(2, j) = tempBook.Name
    i = 8
    Do While tempBook.Sheets("คะแนน1").Range("BA" & i) <> ""
       If (tempBook.Sheets("คะแนน1").Range("BA" & i).Value) = 0 Then
       thsBook.Worksheets("เกรด0").Cells(w, k).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("B" & i).Value
       thsBook.Worksheets("เกรด0").Cells(w, l).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("C" & i).Value
       thsBook.Worksheets("เกรด0").Cells(w, m).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("D" & i).Value
       thsBook.Worksheets("เกรด0").Cells(w, n).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("E" & i).Value
       thsBook.Worksheets("เกรด0").Cells(w, o).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("AZ" & i).Value
       thsBook.Worksheets("เกรด0").Cells(w, 7).Resize(1, 1).Value = tempBook.Sheets("คะแนน1").Range("BA" & i).Value
      ' ดึงมาจากชีท Home
       thsBook.Worksheets("เกรด0").Cells(w, 8).Resize(1, 1).Value = tempBook.Sheets("Home").Range("G5").Value
       thsBook.Worksheets("เกรด0").Cells(w, 9).Resize(1, 1).Value = tempBook.Sheets("Home").Range("G4").Value
       thsBook.Worksheets("เกรด0").Cells(w, 10).Resize(1, 1).Value = tempBook.Sheets("Home").Range("C11").Value
       thsBook.Worksheets("เกรด0").Cells(w, 11).Resize(1, 1).Value = tempBook.Sheets("Home").Range("C12").Value
       thsBook.Worksheets("เกรด0").Cells(w, 12).Resize(1, 1).Value = tempBook.Sheets("Home").Range("D13").Value
       thsBook.Worksheets("เกรด0").Cells(w, 13).Resize(1, 1).Value = tempBook.Sheets("Home").Range("E9").Value
       thsBook.Worksheets("เกรด0").Cells(w, 14).Resize(1, 1).Value = tempBook.Sheets("Home").Range("C17").Value
       w = w + 1
       
        End If
             i = i + 1
             j = j + 1
        Loop
        tempBook.Close False
        fileName = Dir()
       
    Loop
    Application.ScreenUpdating = True
   MsgBox ("รับข้อมูลจาก Directory " & Sheets("Main").Range("B1").Value & " เรียบร้อยแล้วครับ")
End Sub
จะมองหรืออ้างถึงอย่างไรครับอาจารย์ที่ Do While tempBook.Sheets("คะแนน1").Range("BA" & i) <> "" ให้มันอ้างอิงตั้งแต่ เซลล์ BA8:BA62 ในแต่ละไฟล์ให้อ้างอิงเซลล์ดังกล่าว เพราะในทุกๆไฟล์ มีนักเรียน 55 คน ถ้ามีเลขที่ใดลาออก คะแนนจะไม่มี จะมีค่าว่างปรากฏ แต่เราจะบังคับให้มันอ้างอิงจนครบ 55 คน ครับ ภาพที่แสดงด้านล่าง ยังมีข้อมูลว่างเปล่าแสดงเกินมา ตัวอย่าง เลขที่ 16

Re: VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Sun Apr 03, 2016 7:54 pm
by snasui
:D เนื่องจาก
aueijung wrote:i = 8
และ
aueijung wrote:ในทุกๆไฟล์ มีนักเรียน 55 คน
ดังนั้นควรจะปรับให้ Loop ไปจนครบครับ

เมื่อ i เริ่มที่ 8 ก็บวกไปอีก 55 หักออกด้วย 1 เนื่องจากนับ 8 ด้วย ก็จะเป็น 62 ค่าที่ควรจะ Loop

จากเดิม
Do While tempBook.Sheets("คะแนน1").Range("BA" & i) <> ""

ก็จะกลายเป็นเช่นด้านล่างครับ
Do While i <= 62

Re: VBA คัดลอกข้อมูล ตามเงื่อนไขที่พบ จากหลายๆไฟล์

Posted: Sun Apr 03, 2016 8:22 pm
by aueijung
:mrgreen: เย้ๆ ได้แล้วครับอาจารย์ ขอบพระคุณมากครับผม ^^
All times are UTC+07:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited