ช่วยหน่อยครับ อยากดึงข้อมูล ด้วย VBA

[aerojen]

ตอนนี้ผลลัพธ์ ดึงข้อมูลแสดงแนวตั้ง แต่สิ่งที่อยากได้คือผลลัพธ์แสดงผลเรียงลำดับตัวเลขไปตามแนวนอน
และถ้าผลลัพธ์เกิน 10 คอลัมน์อยากให้เพิ่มแถวอัตโนมัติตามไฟล์แนบครับ

[snasui]

ที่เขียนมาแล้วนั้นเพียงแต่ Filter ข้อมูล ลองเขียนในส่วนที่ให้เรียงเป็นแนวนอนมาก่อน ติดตรงไหนค่อยถามกันต่อครับ

[kimmad]

เงือนไขที่ 1
ได้ระดับ 3 เมื่อ
ได้ผลการประเมินระดับ 3 จำนวน 4 ตัวชี้วัด หรือ
ได้ผลการประเมินระดับ 2 ๒-๓ ตัวชี้วัด และได้ผลการประเมิน 2 จำนวน ๑-๒ ตัวชี้วัด
ได้ระดับ 2 เมื่อ
ได้ผลการประเมินระดับ 2 จำนวน 4 ตัวชี้วัด หรือ
ได้ผลการประเมินระดับ 3 หรือ 2 จำนวน ๑- ๒ ตัวชี้วัด และได้ผลการประเมินระดับ 1 จำนวน ๑-๒ ตัวชี้วัด
ได้ระดับ 1 เมื่อ
ได้ผลการประเมินระดับ 1 จำนวน 4 ตัวชี้วัด หรือ
ได้ผลการประเมินระดับ 3 หรือ 2 จำนวน ๑ ตัวชี้วัด และ ได้ผลการประเมินระดับ 1 จำนวน ๓ ตัวชี้วัด
ได้ระดับ 0 เมื่อ
ได้ผลการประเมินระดับ 0 อย่างน้อย ๑ ตัวชี้วัด

[snasui]

เงือนไขที่ 1
ได้ระดับ 3 เมื่อ
ได้ผลการประเมินระดับ 3 จำนวน 4 ตัวชี้วัด หรือ
ได้ผลการประเมินระดับ 2 ๒-๓ ตัวชี้วัด และได้ผลการประเมิน 2 จำนวน ๑-๒ ตัวชี้วัด
ได้ระดับ 2 เมื่อ
ได้ผลการประเมินระดับ 2 จำนวน 4 ตัวชี้วัด หรือ
ได้ผลการประเมินระดับ 3 หรือ 2 จำนวน ๑- ๒ ตัวชี้วัด และได้ผลการประเมินระดับ 1 จำนวน ๑-๒ ตัวชี้วัด
ได้ระดับ 1 เมื่อ
ได้ผลการประเมินระดับ 1 จำนวน 4 ตัวชี้วัด หรือ
ได้ผลการประเมินระดับ 3 หรือ 2 จำนวน ๑ ตัวชี้วัด และ ได้ผลการประเมินระดับ 1 จำนวน ๓ ตัวชี้วัด
ได้ระดับ 0 เมื่อ
ได้ผลการประเมินระดับ 0 อย่างน้อย ๑ ตัวชี้วัด

โพสต์นี้ไม่ได้เป็นคำถามคำตอบต่อเนื่องกันมาของกระทู้นี้ กรุณาตั้งกระทู้ใหม่ครับ

วิธีการตั้งและตอบกระทู้อ่านที่หัวข้อที่ 4 ของประกาศ "โปรดทราบ" ด้านบนครับ

[kimmad]

ขออภัยครับ เกิดข้อผิดพลาด

[aerojen]

ได้ลองเขียน code เองแต่เปลี่ยนเงื่อนไขการหาคำตอบเป็นดังนี้
1) อยากให้ลงข้อมูลดิบในชีท Database แล้ว sort ข้อมูล
2) จากนั้นนำมาเรียงในหน้า summary ให้ได้ผลลัพธ์ตามหน้านี้
โดยเงื่อนไขคือถ้าเกิน 10 Location ให้ขึ้นบรรทัดใหม่
(ตามตัวอย่างจาก Warehouse2 ไป นครสวรรค์)
3) สุดท้าย Break ข้อมูลหน้า summary ไปใส่ในชีทแต่ละ status โดยที่
ถ้าชีท A ก็จะมีข้อมูลที่เกี่ยวกับ status A อย่างเดียว

ซึ่งตอนนี้ติดขั้นตอนที่ 2 เรียงให้ได้ผลลัพธ์ตามชีท 2 ครับ

[snasui]

ใน Code ที่เขียนมาเองนั้น ติดข้อ 2 ติดบรรทัดใด ตรงไหน อย่างไรครับ

Status ในคอลัมน์ C ที่เป็นคำว่า "Check" เอาไว้ทำอะไร มีข้อพิจาณาอย่างไรจึงใส่คำว่า "Check" ครับ

[aerojen]

Status ที่เขียนว่า Check เป็นแค่คำกำหนดให้พนักงานกรอกตัวหนังสือ เช่น จาก Warehouse1 ไป จันทบุรีมี status Z ทั้งหมด 14 Loc ก็ดึงLoc มาเรียงแนวนอน 10 คอลัมน์ อีก 4 คอลัมน์ขึ้นบรรทัดเรียงแนวนอนใหม่ก็ต้องเพิ่มบรรทัด Check มาด้วยเพื่อที่พนักงานจะได้ตรวจสอบด้วยการเขียนลายลักษณ์อักษรลงไปครับ

[snasui]

ตัวอย่าง Code สำหรับทำงานที่ชีต Summary ตามด้านล่างครับ

Code: Select all

Dim cl As New Collection, cItem As Variant
Dim rAll As Range, rs As Range, rt As Range, rtAll As Range
Dim s As String, strc As Variant
Dim iCount As Integer, j As Integer, k As Integer

With Sheets("Database")
    Set rAll = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
End With
On Error Resume Next
For Each rs In rAll
    s = rs.Value & "_" & rs.Offset(0, 1).Value & "_" & rs.Offset(0, 3).Value
    cl.Add s, s
Next rs
On Error GoTo 0
With Sheets("Summary")
    .Range("a2").Resize(100, 13).ClearContents
    For Each cItem In cl
       Set rt = .Range("c" & .Rows.Count).End(xlUp).Offset(1, 0)
       strc = Split(cItem, "_")
       If rt.Offset(0, -2).End(xlUp).Value <> strc(0) And rt.Offset(0, -1).End(xlUp).Value <> strc(1) Then
            rt.Offset(0, -2).Value = strc(0)
            rt.Offset(0, -1).Value = strc(1)
       End If
       iCount = Application.CountIfs(rAll, strc(0), rAll.Offset(0, 1), strc(1), rAll.Offset(0, 3), strc(2))
       rt.Resize(iCount \ 10 + 1).Value = strc(2)
       j = 0
       For Each rs In rAll
            If cItem = rs.Value & "_" & rs.Offset(0, 1).Value & "_" & rs.Offset(0, 3).Value Then
                j = j + 1
                If j > 1 And (j - 1) Mod 10 + 1 = 1 Then
                    Set rt = rt.Offset(1, 0)
                End If
                rt.Offset(0, (j - 1) Mod 10 + 1).Value = rs.Offset(0, 2).Value
            End If
            If j = iCount Then Exit For
       Next rs
    Next cItem
    Set rtAll = .Range("c2", .Range("c" & .Rows.Count).End(xlUp))
    For k = rtAll.Count To 2 Step -1
        rtAll(k).Offset(0, -2).Resize(1, 13).Insert
    Next k
    .Range("c2", .Range("c" & .Rows.Count).End(xlUp).Offset(1, 0)) _
        .SpecialCells(xlCellTypeBlanks).Value = "Check"
End With

ส่วนกรณีคัดลอกไปชีตอื่น ๆ ให้เขียนมาเองก่อน ติดตรงไหนค่อยถามกันต่อ