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

aueijung · #1

Module11 ใช้โค๊ดดังนี้ครับอาจารย์

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

snasui · #2

ตัวอย่างการปรับ 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

aueijung · #3

ใช้ได้แล้วครับอาจารย์ งงอยู่ตั้งนาน ขอบพระคุณมากครับผม

DhitiBank · #4

ขอเอาไฟล์ไปศึกษานะครับ มีคำสั่งหลายอย่างน่าสนใจ

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

snasui · #5

หากหมายถึง fileName = Dir() เป็นคำสั่งให้ไปยังไฟล์ต่อไปครับ

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

aueijung · #6

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

aueijung · #7

นำไฟล์ไปศึกษาได้เลยครับ คุณDhitiBank ^^ ยินดีครับผม

snasui · #8

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

ลองศึกษาและปรับมาเองก่อนเสมอ ติดแล้วค่อยถามครับ

DhitiBank · #9

snasui wrote: หากหมายถึง fileName = Dir() เป็นคำสั่งให้ไปยังไฟล์ต่อไปครับ

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

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

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

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

snasui · #10

เป็นการใช้ Hex Value แทนการคีย์ตัวเลขเข้าไปตรงๆ ครับ

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

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

?&H1F

Enter

DhitiBank · #11

snasui wrote: เป็นการใช้ Hex Value แทนการคีย์ตัวเลขเข้าไปตรงๆ ครับ

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

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

?&H1F

Enter

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

aueijung · #12

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

snasui · #13

เนื่องจาก

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

aueijung · #14

เย้ๆ ได้แล้วครับอาจารย์ ขอบพระคุณมากครับผม ^^

Snasui Excel Forum

File Anatomy Add-in: แก้ปัญหาไฟล์ Excel ช้า แฮงก์ และไม่เสถียร อย่างมืออาชีพ

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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