Excel Forum

ฟอรัม Excel, VBA และอื่นๆ ของคนไทยเพื่อประโยชน์ของทุกคนในจักรวาล (Forum Excel, VBA and others of Thai people for everyone in the universe.)
https://snasui.com/

กำหนดเงือนไขใน VBA

https://snasui.com/viewtopic.php?t=2787

Page 1 of 1

กำหนดเงือนไขใน VBA

Posted: Mon Jun 25, 2012 10:10 am
by Tawat
อาจารย์ครับ รบกวนสอบถามเกี่ยวกับการกำหนดเงื่อนไข ซ้อนๆ กัน

ตามตัวอย่างที่แนบมาให้ครับ

โดยผมใช้สูตร if แต่ผมกำหนดเงื่อนไขซ้ำๆลงไปอีกแล้ว งง ครับ

รบกวนสอบถามว่ามีสูตรไหนที่พอจะทำได้ง่ายๆบ้างครับ

Re: กำหนดเงือนไขใน VBA

Posted: Mon Jun 25, 2012 11:51 am
by bank9597
:D หากจะใช้ VBA จำเป็นต้องเขียนโค๊ดมาเองก่อนเสมอครับ

ส่วนปัญหาดังกล่าว สามารถใช้สูตรได้ครับ
ที่เซลล์ I6 คีย์ =SUMIFS($E$5:$E$12,$B$5:$B$12,$H6,$C$5:$C$12,I$5,$D$5:$D$12,LOOKUP(CHAR(255),$I$4:I$4))
คัดลอกไปทางขวามือ แล้วลงล่างพร้อมกัน

Re: กำหนดเงือนไขใน VBA

Posted: Mon Jun 25, 2012 12:05 pm
by ChoBkuN
อีกซักสูตร นะครับ
I6 key =SUMPRODUCT(--($H6=$B$5:$B$12),--(I$5=$C$5:$C$12),--(IF(I$4="",H$4,I$4)=$D$5:$D$12),$E$5:$E$12)
คัดลอกไปทางขวามือ แล้วลงล่าง

Re: กำหนดเงือนไขใน VBA

Posted: Mon Jun 25, 2012 12:09 pm
by joo
:D วิธีใช้สูตรลองอีกวิธีครับ ที่ I6 คีย์ =SUMPRODUCT(--($D$5:$D$12=I$4),--($B$5:$B$12=$H6),--($C$5:$C$12=I$5),$E$5:$E$12)
Copy ไป J6 และลงล่าง
ที่ K6 คีย์ =SUMPRODUCT(--($D$5:$D$12=$K$4),--($B$5:$B$12=$H6),--($C$5:$C$12=K$5),$E$5:$E$12) Copy ไป L6 และลงล่าง

Re: กำหนดเงือนไขใน VBA

Posted: Mon Jun 25, 2012 12:39 pm
by Tawat
ครับ เนื่องจากฟังชั่นนี้ ผมสามารถทำใน Privote Table ได้ครับ

แต่เนื่องจากหัวหน้าบอกว่าให้ทำเป็น VBA ก่อน เพราะอยากให้พัฒนาการทำ VBA

ซึ่งผมสามารถดึงข้อมูล สินค้า ลูกค้า พร้อมกับหน่วยได้ (กำหนดเป็น array)

แต่ไม่สามารถเอามาลงให้เป็นหน้าตาดังตัวอย่างได้ครับ

โดยตัวอย่างนี้ผม create มาเอง

แต่ข้อมูลที่แท้จริงมีเยอะมากๆ ครับ

Re: กำหนดเงือนไขใน VBA

Posted: Mon Jun 25, 2012 12:45 pm
by bank9597
bank9597 wrote::D หากจะใช้ VBA จำเป็นต้องเขียนโค๊ดมาเองก่อนเสมอครับ

ส่วนปัญหาดังกล่าว สามารถใช้สูตรได้ครับ
ที่เซลล์ I6 คีย์ =SUMIFS($E$5:$E$12,$B$5:$B$12,$H6,$C$5:$C$12,I$5,$D$5:$D$12,LOOKUP(CHAR(255),$I$4:I$4))
คัดลอกไปทางขวามือ แล้วลงล่างพร้อมกัน
ต้องเชียนโค๊ดมาก่อนครับ ติดส่วนไหน จะได้ปรับไปเรื่อยๆ

Re: กำหนดเงือนไขใน VBA

Posted: Mon Jun 25, 2012 1:09 pm
by Tawat
Code คร่าวๆที่ผมทำไว้นะครับ

ประมาณนี้

ส่วนตัวข้อมูลผมต้องขอแก้ไขก่อนนะครับ

เพราะข้อมูลจริงๆ ผม ไม่สามารถเอามาเปิดเผยได้นะครับ

เดวผมขอจำลองข้อมูลคร่าวๆ ไว้แล้วจะแนบไฟล์มาให้อีกทีนะครับ



Sub Test()
num1 = 4
num2 = 0
num4 = 0
num5 = 0
weigth2 = 0
weigth = 0
code1 = "SS"
customer1 = "ss"
status = "ss"


Sheets("sheet1)").Select
Range("A" & num1).Select


Do Until ActiveCell.Value = Empty
code2 = ActiveCell.Value
customer2 = ActiveCell.Offset(0, 1)
ActiveCell.Offset(1, 0).Select



If code1 = code2 Then
codearray(num4) = ActiveCell.Value
Else
weigtharray2(num4) = weigth
customerarray(num4) = customer2
weigth = ActiveCell.Offset(-1, 3)
codearray(num4) = code2
num4 = num4 + 1
End If


If code1 = code2 And customer1 = customer2 Then
customerarray(num5) = ActiveCell.Offset(-1, 1).Value
weigth = weigth + ActiveCell.Offset(-1, 3).Value
Else
customerarray(num5) = customer2
num5 = num5 + 1
End If


code1 = code2
customer1 = customer2
Loop

Re: กำหนดเงือนไขใน VBA

Posted: Mon Jun 25, 2012 1:22 pm
by Tawat
สำหรับตัวอย่างคร่าวๆนะครับ

ของข้อมูลที่ต้องการทำ

Re: กำหนดเงือนไขใน VBA

Posted: Mon Jun 25, 2012 7:48 pm
by snasui
:D แนบ Code มาในไฟล์ด้วยครับจะได้ช่วยตรวจสอบให้ได้ ไฟล์ที่แนบ Code มาได้นั้นจะต้องมีนามสกุลเป็น .xlsm สำหรับ Excel 2007 ขึ้นไปและจะมีนามสกุลเป็น .xls หากว่าเป็น Excel 2003 ลงไปครับ

Re: กำหนดเงือนไขใน VBA

Posted: Tue Jun 26, 2012 7:02 am
by Tawat
ครับผม

Re: กำหนดเงือนไขใน VBA

Posted: Tue Jun 26, 2012 8:01 am
by Tawat
ประมาณนี้นะครับ

ผมทำไว้คร่าวๆ แต่ยังงง กับการกำหนดเงื่อนไขซ้อนกันหลายๆเงื่อนไข

เลยประกาศตัวแปรไว้เพรียบเลย

Re: กำหนดเงือนไขใน VBA

Posted: Tue Jun 26, 2012 6:29 pm
by snasui
:D ค่อย ๆ ถามตอบกันไปนะครับ

คำว่า Total ตามภาพด้านล่างจำเป็นต้องมีหรือไม่ครับ ถ้าจำเป็น ต้องการไว้รวมค่าใด เนื่องจากยอด Total คือค่าที่ทำวงกลมเอาไว้แล้วครับ

Re: กำหนดเงือนไขใน VBA

Posted: Wed Jun 27, 2012 7:40 am
by Tawat
อาจารย์ครับ เดี๋ยวผมแนบไฟล์ไปให้อีกรอบนะครับ

แบบว่าต้องการเอาไว้ด้านล่างสุด เพื่อ Sum ผมรวมทั้งหมดแค่ค่าเดียวครับ

ผมลองทำสูตรขั้นตอนแรกคือเอา code ที่ซ้ำกันทั้งหมดให้เหลือแค่ Code เดียว

แล้วก็รวม Weigth ที่เป็น code เดียวกันได้แล้วครับ พอจะมาแยก Status และ Customer อีก

ผมเริ่มสับสนกับมันแล้ว เพราะมันต้องแยก Weigth เพิ่มอีก แล้วข้อมูลที่แยกไว้ไปลองอีก sheet นึง

ก็ไม่ได้แล้ว ไม่รู้จะเริ่มต้นยังไงครับ

Re: กำหนดเงือนไขใน VBA

Posted: Wed Jun 27, 2012 8:26 am
by Tawat
จากที่ทำนะครับ Weigtharray() ของตัวสุดท้ายจะไม่ขึ้นครับ

รบกวนอาจารย์ช่วยแนะนำด้วยครับ

Re: กำหนดเงือนไขใน VBA

Posted: Wed Jun 27, 2012 11:02 am
by Tawat
ล่าสุดครับ

Re: กำหนดเงือนไขใน VBA

Posted: Wed Jun 27, 2012 6:36 pm
by snasui
:D หากสร้าง Report ด้วย การบันทึก Macro เพื่อสรุปข้อมูลด้วย PivotTable จากนั้นใช้ Code เพื่อ Copy ลักษณะของตารางมาใช้และปรับ Format ไม่ทราบว่าหัวหน้าติดประเด็นอะไรหรือไม่ครับ การเขียน Code เพื่อทำในสิ่งที่ความสามารถปกติทำได้อยู่แล้วผมเห็นว่าสิ้นเปลืองเวลาโดยใช่เหตุครับ

Re: กำหนดเงือนไขใน VBA

Posted: Thu Jun 28, 2012 7:01 am
by Tawat
อ้อครับ ที่จริงสามารถทำจาก Privot table ได้ครับ

แต่หัวหน้าผมอยากให้ผมเรียนรู้เกี่ยวกับการทำ VBA เพื่อจะใช้ในโอกาสต่างๆครับ

เป็นงานที่ไม่เร่งอะไรครับ เพราะ Report ผมทำ Privot table ส่งไปแล้ว

และผมก็อยากจะเรียนรู้กับการเขียน code VBA ด้วยครับ

รบกวนแนะนำด้วยนะครับ

Re: กำหนดเงือนไขใน VBA

Posted: Thu Jun 28, 2012 7:28 pm
by snasui
:D เพื่อให้เพื่อน ๆ ได้ใช้ศึกษาไปด้วย ผมเขียน Code ตัวอย่างตามด้านล่าง ซึ่งไม่รวมการจัดรูปแบบครับ

Code: Select all

Sub Test0()
    Dim rAll As Range, r As Range, rBlanks As Range
    Dim i As Integer, rCus As Range, rCod As Range
    Application.ScreenUpdating = False
    With Sheets("Sheet2")
        .Range("A:F").Clear
        .Range("E1") = "x"
        Sheets("Sheet1").Range("B2").CurrentRegion.Copy .Range("A1")
        Set rAll = .Range("A2", .Range("A2").End(xlDown))
        For Each r In rAll
            r.Offset(0, 4) = r & r.Offset(0, 1) & r.Offset(0, 2)
        Next r
        Set rAll = rAll.Offset(0, 4)
        For Each r In rAll
            r.Offset(0, 1) = Application.SumIf(rAll, r, rAll.Offset(0, -1))
        Next r
        rAll.Offset(0, -1) = rAll.Offset(0, 1).Value
        .Range("A1").CurrentRegion.RemoveDuplicates Columns:=5
        Set rAll = rAll.Offset(0, -4)
        For i = rAll.Count To 1 Step -1
            If rAll(i).Row > 2 And rAll(i) <> rAll(i).Offset(-1, 0) Then
                rAll(i).EntireRow.Insert
            End If
        Next i
        Set rBlanks = .Range("A2", .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)) _
            .SpecialCells(xlBlanks)
        For Each r In rBlanks
            r = "Code " & r.Offset(-1, 0) & " Total"
            r.Offset(0, 3) = Application.SumIf(rAll, r.Offset(-1, 0), rAll.Offset(0, 3))
        Next r
        For Each r In rAll
            If r.Offset(0, 1) <> "" Then r.Offset(0, 4) = r & r.Offset(0, 1)
        Next r
        Set rAll = rAll.Offset(0, 4)
        i = 1
        For Each r In rAll
            Set rCus = .Range("E2").Resize(i)
            Set rCod = .Range("A2").Resize(i)
            If Application.CountIf(rCus, r) > 1 Then r.Offset(0, -3) = ""
            If Application.CountIf(rCod, r.Offset(0, -4)) > 1 Then r.Offset(0, -4) = ""
            i = i + 1
        Next r
        .Range("E:F").Clear
    End With
    Application.ScreenUpdating = True
End Sub

Re: กำหนดเงือนไขใน VBA

Posted: Fri Jun 29, 2012 6:58 am
by Tawat
ขอบพระคุณมากครับ อาจารย์
All times are UTC+07:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited