Stationery Record and Monitoring for charge

[yukioh]

สะหวัดดีครับ อาจารย์,
ก่อนอืนผมต้องออกตัวก่อนว้า ภาษาไทย ไม้ค้อยเก่งเท้าไห่ลครับ, ผมมีปัญหา มารบกวนอาจารย์ช้วยด้วยอีกแล้วครับ

1. ผมต้องกานจะสะหลุบ Doc./Dept พายใน sheet Pen, DVD, CD, A4 และ อื่นฯ ว่าแต่ละพะแนก เบีกใช้อุปกรณ์เครื่องเขียนในตะละเดือนนั้นเท้าไหล
โดยที่เมื้อเราเลือก เดือนตรงที่ Summry แล้ว ให้สหลุบตามเดือนที่เราเลือกครับอาจารย์

รบกวนอาจารย์ด้วยนะครับ

[snasui]

ลองตามนี้ครับ

ที่ D38 คีย์สูตร

=SUMPRODUCT(--(MONTH(1&$B$35)=MONTH($B$7:$B$33)),--($C$7:$C$33=$B38),$K$7:$K$33)

Enter > Copy ลงด้านล่าง

กรณีไม่ได้คำตอบ ช่วยอธิบายมาอย่างละเอียดว่ามีเงื่อนไขอะไรบ้าง ยกตัวอย่างข้อมูลและตัวอย่างคำตอบที่ต้องการมาด้วยเพื่อจะได้เข้าใจตรงกันครับ

[yukioh]

ครับ อาจารย์,
ผมได้ใส่สูดลงไปตามที่อาจารย์มให้แล้วครับ, มันไม้สะแดงค้าใดฯออกมาเลียครับ,
สมมุดว้า ถ้าผมเลือก:
เดือน 9(Sep) จะได้: และ เดือน 10(Oct) จะได้:

AD N05 120,667.00 N N01 40,000.00
F N07 667.00 O N10 40,000.00
C N04 38,019.00 P N12 40,000.00
O N10 61,312.00 PF N071 80,000.00
CC S22 200.00 AD N05 120,000.00
N N01 80,200.00
P N12 60,000.00
PF N071 100,000.00
H N08 20,000.00
AU N14 20,000.00
HLT S23 4,000.00
I N09 8,000.00

[yukioh]

ขอโทษ ครับ ผมลืมแนบไฟล

[snasui]

เซลล์ J47 มีค่าเท่ากับ 120,667.00 ประกอบด้วยเซลล์ใดบ้างครับ

[yukioh]

ขอโทดครับ สงใสผมใส่ formula ผิดครับ

Cell J47 มีค่าเท่ากับ 667 ครับ พะแนก AD เดือน 9. (ประกอบด้วยเซลล์ K9 อย่างเดีวยครับ)
Cell J50 มีค่าเท่ากับ 21,312 ครับ พะแนก O เดือน 9. (ประกอบด้วยเซลล์ K13,K14 และ K19)

[snasui]

Cell J47 มีค่าเท่ากับ 667 ครับ พะแนก AD เดือน 9. (ประกอบด้วยเซลล์ K9 อย่างเดีวยครับ)

เซลล์ J47 จะได้ผลลัพธ์เป็น 667 ไปไม่ได้ครับ เพราะว่า B9 ไม่ใช่เดือน 9

[yukioh]

ขอบคุณมากครับอาจารย์ ที่แนะนำ, ผมทำแก้ได้แล้วครับ..
ผมบออนุญาต ถามต่ออีกนะครับ
หลังจากที่ได้ Summary ในแต่ละ item แล้ว, ผมต้องกานที่จะเอามารวมกันทังหมดเลียใน "Summary" sheet ครับ โดยกานกดปุม ."Get Data Summary"

รบกวนบอาจารย์ ด้วยครับ..

[snasui]

ไม่เข้าใจครับ ไม่ทราบว่าต้องการจะทำอะไร ในการนำไฟล์มาถามไม่ควรซ่อนชีท ซ่อน Scroll Bar เพราะจะทำให้เกิดความยุ่งยากที่จะต้องเข้าไปกำหนดเองใหม่

ชีท Summary นั้นมีสูตรสำหรับดึงข้อมูลอยู่แล้วไม่ทราบว่าต้องการผลลัพธ์เป็นอย่างไร ที่บันทึก Macro มานั้นไม่ถูกต้องตรงไหน ช่วยระบุรายละเอียดมาด้วยครับ

[yukioh]

ขออภัยครับ อาจารย์,
เนื่องจากว้า ในแต่ละเดือนนั้นจะมีกานบันทิกข้อมูน และ จะเป็นต้อง insert row ในในแต่ละ Item เช้น Pen, DVD etc.. เพื่อเพี่มตะลางในกานบันทิก
ชื้ง Macro "Get Data Summary" มันข้อนค้างจะ Fix Cell , และ ผมต้องกานที่จะนำ Summary ในแต่ละรายกานของ Pen, DVD etc..มารวมกันใน sheet เดียว
ถ้าเกีดผม insert row เพี้มใน แต้ละรายกานแล้ว Macro "Get Data Summary" ก็อาดจะนำข้อมูนมาผีดพลาด, ชิ้งผมต้องกาน:
- นำ Summary ในแต่ละรายกาน (Pen,CD,DVD..)มารวมกัน ใน sheet "Summary",โดยที่ เวลา insert row ในในแต่ละ Item จะไม้มีผนกับ Macro
- Remove ตัวที่ช้ำกัน ออก เช้น พะแนก Ad ในแต่ละ item (Pen,CD,DVD..) ออก เพื้อให้ สะแดงใน sheet "Summary" เพียงอันเดียว

รบกวนบอาจารย์ ด้วยครับ..

[snasui]

ลองดูตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("Summary").Select
    Range("a4:a65530").ClearContents
    Sheets("PEN").Select
    Range("B38").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Summary").Select
    Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'    Range("A3").Select
'    Selection.End(xlDown).Select
'    Range("A24").Select
'    Selection.End(xlUp).Select
'    Selection.End(xlDown).Select
'    Range("A18").Select
'    Selection.End(xlUp).Select
'    Selection.End(xlDown).Select
'    Application.CutCopyMode = False
    Sheets("DVD").Select
    Range("B28").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Summary").Select
    Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'    Range("A26").Select
'    Selection.End(xlDown).Select
    Sheets("CD").Select
    Range("B28").Select
    Range(Selection, Selection.End(xlDown)).Select
'    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Summary").Select
    Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'    Selection.End(xlDown).Select
'    Range("A68").Select
    Sheets("A4").Select
    Range("B28").Select
    'Range(Selection, Selection.End(xlToRight)).Select
    'Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
'    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Summary").Select
    Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'    Selection.End(xlDown).Select
'    Selection.End(xlUp).Select
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
'    Application.CutCopyMode = False
    ActiveSheet.Range("$A$3:$A$89").RemoveDuplicates Columns:=1, Header:=xlYes
'    ActiveWindow.SmallScroll Down:=0
    Range("A5").Select
End Sub

[yukioh]

สวัสดีครับ อาจารย์,
ผมได้ลองใส่ ตามที่อาจานให้มาแล้วครับ, และ ผมได้ลอง Insert row ที่ Sheet "Pen,DVD,CD,A4"ลองดูแล้ว ปลากดว่า ม้นจะรวมข้อมูนที่ผิด และ ไม้ครบตามที่ต้องกานครับ

[snasui]

ลองดูตัวอย่างการปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub Macro1()
    Range("a4:a65530").ClearContents
    Sheets("PEN").Select
    Range("B" & Application.Match("Summary", Sheets("PEN").Range("B:B"), 0)).Offset(2, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Summary").Select
    Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("DVD").Select
    Range("B" & Application.Match("Summary", Sheets("DVD").Range("B:B"), 0)).Offset(2, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Summary").Select
    Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("CD").Select
    Range("B" & Application.Match("Summary", Sheets("CD").Range("B:B"), 0)).Offset(2, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Summary").Select
    Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("A4").Select
    Range("B" & Application.Match("Summary", Sheets("A4").Range("B:B"), 0)).Offset(2, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Summary").Select
    Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range("$A$3:$A$89").RemoveDuplicates Columns:=1, Header:=xlYes
    Range("A5").Select
End Sub

[yukioh]

อาจารย์,
พอจะมีวีทีที้ส้นกว่านี้ไหมครับ?

[snasui]

มีแน่นอนครับ ไม่ต้องรีบร้อนในการปรับ Code ครับ ขอให้ศึกษาการทำงานของ Code ให้เข้าใจก่อน จากนั้นลองศึกษา Looping หากเข้าใจแล้วจะสามารถปรับ Code ให้สั้นลงได้เอง หรือหากปรับแล้วติดปัญหาก็ถามมาได้เสมอครับ

[yukioh]

สวัสดีครับ อาจารย์
ผมได้ใส่ Code "1) Get All Data" เข้าไปครับ และ ได้เสีม code :

" Range("B" & Application.Match("Summary", Sheets("PEN").Range("B:B"), 0)).Offset(2, 0) "

ที่อาจารย์ ให้มาก่อนหน้านี้ รู้สิกว่า data มาไม้หมด

รบกวนบอาจารย์ ช้วยดูให้ด้วยครับ..

[snasui]

ลองปรับเป็นด้านล่างครับ

Code: Select all

Sub Macro1()
   '...Other code
    Range(Selection, Selection.End(xlDown)).Select
    Selection.RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A5").Select
End Sub

Code ด้านบนคือ 3 บรรทัดสุดท้าย ส่วน '...Other code คือ Code เดิมครับ

[yukioh]

ครับ อาจารย์
รบกวน อาจารย์ ดู Module 3 ให้ด้วยครับ ที่เป็นปุ่ม "1) Get All Data" ผมได้ใส่เข้าไปครับ

Code: Select all

Sub Get_data_all_item() ' GET DATA FROM ALL ITEM
    Dim rSource As Variant
    Dim rTarget As Range
    Dim i As Integer
    Sheets("Summary").Range("A4:A" & Rows.Count).Clear
    rSource = Array(Sheets("PEN").Range("B" & Application.Match("Summary", Sheets("PEN").Range("B:B"), 0)).Offset(2, 0), _
                            Sheets("DVD").Range("B" & Application.Match("Summary", Sheets("DVD").Range("B:B"), 0)).Offset(2, 0))
     
     
    For i = 0 To UBound(rSource)
        Set rTarget = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        rSource(i).Copy rTarget
    Next i
End Sub

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub Get_data_all_item() ' GET DATA FROM ALL ITEM
    Dim rSource As Variant
    Dim rTarget As Range
    Dim i As Integer, j As Integer
    Sheets("Summary").Range("A4:A" & Rows.Count).Clear
    rSource = Array("PEN", "DVD", "CD", "A4")
    For i = 0 To UBound(rSource)
        With Sheets(rSource(i))
            Set rTarget = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            j = Application.Match("Summary", .Range("B:B"), 0)
            .Range(.Range("B" & j).Offset(2, 0), .Range("B" & Rows.Count).End(xlUp)).Copy rTarget
        End With
    Next i
    With Sheets("Summary")
        .Range("A4", .Range("A" & Rows.Count).End(xlUp)). _
            RemoveDuplicates Columns:=1, Header:=xlNo
    End With
End Sub

[yukioh]

ขอบคุณมากครับอาจารย์ ใช้ได้ตามที่ต้องกานเลียครับ.
อาจารย์ ครับ ผมขอถามตอ,
-ถ้าเกีดว้า มี item อืน นอกจาก Pen, DVD, CD, A4 แล้ว ต้องได้เตีมใส่:

Code: Select all

rSource = Array("PEN", "DVD", "CD", "A4", .....,......)

ใช้ไหมครับ ?

-และ ทำไม formula:
=LOOKUP(9.99999999999999E+307,CHOOSE({1,2},0,IF($A4<>"",LOOKUP(2,1/($A4=INDIRECT("'"&SUBSTITUTE(B$2," ","")&"'!B4:B110")),INDIRECT("'"&SUBSTITUTE(B$2," ","")&"'!L2:L110")))))

มันไม่สะแดงผนครับอาจาน?