ดึงข้อมูลตามเงื่อนไขจาก แนวดิ่ง เป็นแนวนอน

[parakorn]

สวัสดีครับอาจารย์
จากไฟล์ที่แนบ ต้องการ ผลลัพท์ ที่ Sheet "Database" ตั้งแต่แต่ D5:O5,D9:O9 และ D13:O13
โดยดึงข้อมูลจาก Sheet "Home" Range B11:B20,D11:D20,F11:F20 และ H11:H20
โดยต้องการผลลัพท์ ตามตัวอย่างที่ กรอกไว้ครับ

ขอรบกวนด้วยครับผม

[DhitiBank]

ลองแบบนี้ครับ
ที่ D5 คีย์

=IFERROR(INDEX(INDEX(Home!$B$11:$D$20,0,MATCH(LEFT(D4,4),{"Step","","Pric"},0)),SMALL(IF(LOOKUP(CHAR(255),$A$3:$A3)=Home!$F$11:$F$20,ROW(Home!$F$11:$F$20)-ROW(Home!$F$11)+1),INT((COLUMNS($D5:D5)-1)/2)+1)),"")

แล้วกด Ctrl+Shift ค้างไว้ แล้ว Enter
จากนั้นคัดลอกไปยังเซลล์ที่เกี่ยวข้องครับ

[parakorn]

ขอบคุณครับ ♥

[parakorn]

ขอบคุณครับ
ขอถามเพิ่มในส่วนผลลัพท์ Sheet"Database" D17:O17
โดยมีเงื่อนไขคือ ที่ Sheet"Home" ที่ Cell F5 ต้องมีค่ามากว่า 0 และ ที่ F11:F20 ต้องมี "ป้ายขายสดหน้าร้าน"
รบกวนเพิ่มเติมด้วยครับ

ปล.ขออภัยที่ไม่สามารถแนบไฟล์ได้ครับ

[DhitiBank]

ลองปรับสูตรที่ D17 ครับ

=IFERROR(IF(Home!$F$5>0,INDEX(INDEX(Home!$B$11:$D$20,0,MATCH(LEFT(D16,4),{"Step","","Pric"},0)),SMALL(IF(LOOKUP(CHAR(255),$A$3:$A15)=Home!$F$11:$F$20,ROW(Home!$F$11:$F$20)-ROW(Home!$F$11)+1),INT((COLUMNS($D17:D17)-1)/2)+1)),""),"")

Ctrl+Shift+Enter -->คัดลอกไปทางขวา

เสร็จแล้วคีย์ในเซลล์ A15 ว่า "ป้ายขายสดหน้าร้าน" (ไม่ต้องใส่อัญประกาศนะครับ)

[parakorn]

ขอบคุณครับ
ขอถามต่อเลยนะครับ
จากไฟล์ที่แนบ ต้องการเพิ่มโค้ดตรวจสอบความถูกต้อง ดังนี้ครับ
Sheet "Home" ที่ปุ่ม "ป้ายขายสดหน้าร้าน" ต้องการให้สามารถบันทึกข้อมูล
เมื่อมีข้อมูลราคาที่ Sheet "Database" Range D13 ครับ โค้ดที่ผมเขียนขึ้นมัน Error ต้องปรับอย่างไรครับ

Code: Select all

Sub Save»éÒ¢ÒÂʴ˹éÒÃéÒ¹()
' Save»éÒ¢ÒÂʴ˹éÒÃéÒ¹ Macro
With SheetDatabase
    If .Range("D13") = "" Then
        MsgBox "Your data not complete. Please verify and try again."
        Exit Sub
    End If
End With
A = MsgBox("µéͧ¡Òúѹ·Ö¡", vbCritical + vbYesNo)
If A = vbYes Then
    For i = 1 To 1
    Application.Goto Reference:="msrec»éÒ¢ÒÂʴ˹éÒÃéÒ¹"
    Selection.Copy
    Application.Goto Reference:="uldt»éÒ¢ÒÂʴ˹éÒÃéÒ¹"
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Home").Select
    Range("B5").Select
    Selection.ClearContents
    Next i
    End If
End Sub

[bank9597]

ผมขอแนะนำนิดนึงครับ ถ้าหากจะใช้โค๊ด ควร (ต้อง) ใช้ภาษาอังกฤษเท่านั้นครับ ทั้งชื่อชีท ชื่อฟังก์ชั่น

ลองแก้ตามที่ผมบอกก่อนครับ แล้วลองทดสอบโค๊ดใหม่

[parakorn]

แก้เป็นภาษาอังกฤษทั้งหมดแล้วครับ ยัง error ครับผม
รบกวนด้วยนะครับ

[DhitiBank]

ลองปรับโค้ดเป็นแบบนี้ครับ

Code: Select all

Sub SaveBlue()
' SaveBlue Macro
        With Sheets("Database")
            If .Range("D13").Value = "" Then
                MsgBox "Your data not complete. Please verify and try again."
                Exit Sub
            End If
        End With
        A = MsgBox("Are you sure?", vbCritical + vbYesNo)
        If A = vbYes Then
            Application.Goto Reference:="msrecBlue"
            Selection.Copy
            Application.Goto Reference:="uldtBlue"
            ActiveSheet.Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Application.CutCopyMode = False
            Sheets("Home").Select
            Range("B5").Select
            Selection.ClearContents
        End If
End Sub

ไม่ทราบว่ามีการทำงานในลักษณะวนซ้ำๆ หรือเปล่าครับ หากไม่มี ผมขอเอา For ... Next ออกนะครับ

[parakorn]

ได้แล้วครับ ขอรบกวนสอบถามต่อเลยนะครับ
จากไฟล์แนบ ที่ Sheet"Blue" เป็นขอมูลที่ถูกถอดสูตรออก
ทำให้ Cell ที่ผม Hilight ไม่ใช่ Blank ทำให้ ผมไม่สามารถ
นำข้อมูล Import เข้าโปรแกรมพิมพ์ป้ายราคาได้
ผมจึงขอรบกวน ขอวิธีเลือกข้อมูล เฉพาะที่ผม Hilight
เพื่อทำการ Delete ให้ Cell กลายเป็น Blank

ขอความกรุณาด้วยนะครับ.

[DhitiBank]

ลองแบบนี้ครับ โค้ดด้านล่างนี้จะลบค่าในเซลล์ที่แต่เดิมเป็น "" ออกด้วยการ Clear เสร็จแล้วจะเลือกช่วง uldtBlue เฉพาะเซลล์ที่มีข้อมูลอยู่ครับ

Code: Select all

Sub ChooseBlueReccord()
'
' Macro1 Macro
    Dim r As Range, rBlue As Range
    With ActiveSheet
        Set rBlue = .Range("dtblue")
        For Each r In rBlue
            If Len(r.Value) < 1 Then r.Clear
        Next r
        Set rBlue = .Range("dtblue").SpecialCells(xlCellTypeConstants)
    End With
    rBlue.Select
End Sub

[parakorn]

ขอบคุณครับผม ♥