VBA ถ้าค่าเซลหน้าไม่ว่างให้ทำงานไปเรื่อย

[yodpao.b]

ถ้าคอลัม A ไม่ใช่ค่าว่างให้ใส่สูตร =ROUND(H6+I6,6)
หรือเอา H กับ I มารวมกัน
ถ้าเจอค่าว่างให้หยุดทำ

VBA ใส่สูตร.JPG (65.02 KiB) Viewed 175 times

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

[snasui]

การทำเช่นนั้นไม่ใช่เรื่องยาก ลองแนบไฟล์ที่บันทึกเป็น Macro มาถามกัน จะได้ช่วยดูให้ได้ คำถามเกี่ยวกับ VBA ควรจะลองทำมาเองก่อนเสมอ ได้เท่าไรก็เท่านั้นครับ

[yodpao.b]

ผมทำได้ยรรทัดเดียวตรับ

pic 1.JPG (59.61 KiB) Viewed 170 times

ไม่รู้จะให้มันดูบรรทัดต่อไปอย่างไร

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Sub Macro1()
    Dim r As Range
    With Sheets(1)
        For Each r In .Range("h4", .Range("h" & .Rows.Count).End(xlUp))
            If r.Value <> "" Then
                r.Offset(0, 3).Value = r.Value + r.Offset(0, 1).Value
            End If
        Next r
    End With
End Sub

[yodpao.b]

ผมเจอแล้วครับ

Sub Macro2()
'ใส่ค่าในเชล ข้อแม้คือจนกว่าต่าด้านหน้าจะว่าง
i = 1
Do Until Cells(i + 4, 8).Value = ""
Cells(i + 4, 12) = Cells(i + 4, 8) + Cells(i + 4, 9)
i = i + 1
Loop

End Sub

กว่าจะเข้าใจ
แต่ใช้ของอาจาร์ยดีกว่าเข้าใจง่ายกว่าเยอะ

[yodpao.b]

ทำงานตั้งแต่บรรทัดแรก
ลงไปช้างล่างที่ละ1 นาที
ถีงค่ามากสุดในคอลัม L

VBA 2.JPG (79.73 KiB) Viewed 164 times

Code: Select all

Sub Macro_check2()
'ãÊè¤èÒã¹àªÅ
Range("Q5").Value = Range("L5").Value
    Dim r As Range
    With Sheets(1)
        For Each r In .Range("L5", .Range("L" & .Rows.Count).End(xlUp))
            If r.Value <> "" Then
                r.Offset(1, 5).Value = "=R[-1]C+(1/60/24)"
            End If
        Next r
    End With
End Sub

ผมทำไมสำเร็จลงไปได้มากกว่าคอลัม L บรรทัดเียว
ไม่ถึงค่า MAX ในคอลัม L
ไม่รู้ว่าจะให้มองค่าสูงสุดอย่างไร

[puriwutpokin]

ลองปรับเป็น

Code: Select all

Sub Macro_check2()
'ใส่ค่าในเชล
Range("Q5").Value = Range("L5").Value
    Dim i As Integer
    With Sheets(1)
        For i = 0 To Minute(Application.Text(.Range("L" & .Rows.Count).End(xlUp), "hh:mm:ss")) - 1
                Cells(5 + i, 12).Offset(1, 5).Value = "=R[-1]C+(1/60/24)"
        Next i
    End With
End Sub

[Bo_ry]

ลองดู

Code: Select all

Sub run()
sd = Range("L5")
ed = Range("L1048576").End(xlUp) + TimeValue("00:01:00")
r = 5
For n = sd To ed Step TimeValue("00:01:00")
    Range("Q" & r) = n
    r = r + 1
Next n
End Sub

[yodpao.b]

Code: Select all

Sub Macro_check2()
'ใส่ค่าในเชล
Range("Q5").Value = Range("L5").Value
    Dim i As Integer
    With Sheets(1)
        For i = 0 To Minute(Application.Text(.Range("L" & .Rows.Count).End(xlUp), "hh:mm:ss")) - 1
                Cells(5 + i, 12).Offset(1, 5).Value = "=R[-1]C+(1/60/24)"
        Next i
    End With
End Sub

ใช้ได้ครับแต่มันไม่เขากับสูตรที่จะทำต่อไปครับ

ส่วนโคดด้านล่างใช้ได้ครับเขากับสูตรที่จะทำต่อไป
อยากใส่สูตร IF(VLOOKUP(Q5,$L$5:$M$100000,1)=Q5,VLOOKUP(Q5,$L$5:$M$100000,2),0)
ไว้กับโคดด้านล่างครับ

Code: Select all

Sub Macro_runtime()
'ãÊè¤èÒã¹àªÅ
sd = Range("L5")
ed = Range("L1048576").End(xlUp) + TimeValue("00:01:00")
r = 5
For n = sd To ed Step TimeValue("00:01:00")
    Range("Q" & r) = n
    r = r + 1
Next n
End Sub

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

VBA 3.JPG (63.39 KiB) Viewed 153 times

[yodpao.b]

ช่วยแก้ไขโคดให้ถูกหลักด้วยครับ

VBA 4.JPG (45.15 KiB) Viewed 151 times

ใน excel ไม่อยากให้แสดงเป็นสูตร
ต้องการให้แสดงเป็นค่า
โดคที่เห็นมันทำงานถูกต้องแล้วครับแต่อยากให้แก้โดคในกรอบสี่เหลี่ยมหน่อยครับ
มันดูไม่ดูหลักการเขียน
ขอบคุณครับ

Code: Select all

Sub Macro_runtime()
'ใส่ค่าในเชล
sd = Range("L5")
ed = Range("L1048576").End(xlUp) + TimeValue("00:01:00")
r = 5
For n = sd To ed Step TimeValue("00:01:00")
    Range("Q" & r) = n
    Range("R" & r) = "=IF(VLOOKUP(RC[-1],R5C12:R100000C13,1)=RC[-1],VLOOKUP(RC[-1],R5C12:R100000C13,2),0)"
    Range("R" & r) = Range("R" & r)
    r = r + 1
Next n
End Sub

[snasui]

Code นั้นใช้ได้ครับ

หากจะปรับก็จะเป็น Range("R" & r).value = Range("R" & r).value มีความหมายเหมือนกัน ซึ่งค่า Default ของ Property ของเซลล์ใด ๆ คือ .value หากไม่ใส่ก็มีค่าเท่ากัน การเขียน Code ที่เป็น Best Practice จะใส่เสมอ รวมถึงอื่น ๆ เช่นการประกาศตัวแปร ฯลฯ ครับ

[yodpao.b]

ช่วยดูไฟล์ให้หน่อยครับ กดปุ่ม check ทำงานช้ามาก
ผมว่ามันเกี่ยวกับสูตรแน่นอน
พอเพิ่มcode ช้าเลย

Code: Select all

    Range("R" & r).Value = "=VALUE(TEXT(RC[-1],""dd/mm/yyyy""))"
    Range("R" & r).Value = Range("R" & r).Value
    Range("S" & r).Value = "=VALUE(TEXT(RC[-2],""hh:mm:ss""))"
    Range("S" & r).Value = Range("S" & r).Value
    Range("T" & r).Value = "=IF(VLOOKUP(RC17,R5C12:R100000C13,1)=RC17,VLOOKUP(RC17,R5C12:R100000C13,2),0)"
    Range("T" & r).Value = Range("T" & r).Value

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Dim dic As Object

Sub Macro_check1()
'ใส่ค่าในเชล ข้อแม้คือจนกว่าต่าด้านหน้าจะว่าง
    Dim r As Range
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets(1)
        For Each r In .Range("h5", .Range("h" & .Rows.Count).End(xlUp))
            If r.Value <> "" Then
                r.Offset(0, 4).Value = r.Value + r.Offset(0, 1).Value
                If Not dic.exists(CStr(Left(r.Offset(0, 4).Value2, 12))) Then
                    dic.Add Key:=CStr(Left(r.Offset(0, 4).Value2, 12)), Item:=r.Offset(0, 2).Value
                End If
                r.Offset(0, 5).Value = r.Offset(0, 2).Value
            End If
        Next r
    End With
End Sub

Sub Macro_runtime()
'ใส่ค่าในเชล
    Dim arr(999999, 3) As Variant, r As Long
    Dim sd As Double, ed As Double, n As Date
    With Sheets(1)
        sd = .Range("L5").Value2
        ed = .Range("L" & .Rows.Count).End(xlUp).Value2 + TimeValue("00:01:00")
        For n = sd To ed Step TimeValue("00:01:00")
            arr(r, 0) = n
            arr(r, 1) = n - TimeValue(n)
            arr(r, 2) = TimeValue(n)
            If dic.exists(Left(CStr(CDbl(n)), 12)) Then
                arr(r, 3) = dic.Item(Left(CStr(CDbl(n)), 12))
            Else
                arr(r, 3) = 0
            End If
            r = r + 1
        Next n
        .Range("q5").Resize(r, 4).Value = arr
    End With
    MsgBox "Finished.", vbInformation
End Sub

[yodpao.b]

ผมลองแล้วครับ เร็วขึ้น แต่ค่า kw ผิดครับ บางช่องควรโชวค่า แต่ไม่โชว

[snasui]

ค่า kw ผิดครับ บางช่องควรโชวค่า แต่ไม่โชว

ทบทวน Code ที่ผมตอบไปอีกครั้ง เนื่องจากมี Edit เพิ่มฟังก์ชั่น Left เข้าไปด้วย หากยังไม่ถูกต้องช่วยแจ้งรายละเอียดพร้อมไฟล์ล่าสุดมาด้วยจะได้ช่วยดูต่อไปจากนั้นครับ

[yodpao.b]

โพสต ขอข้ามก่อนเขา
พอดีมีงานเก่าเขาเพิ่มเติมมา

[yodpao.b]

พอดีผมจะใช้สูตร copy ทุกๆเเชลที่มีค่ากับไฟลอื่น
นึกได้ใช้ โคด้ด้านบนก็ได้

Code: Select all

Sub Macro1()
    Dim r As Range
    With Sheets(1)
        For Each r In .Range("h4", .Range("h" & .Rows.Count).End(xlUp))
            If r.Value <> "" Then
                r.Offset(0, 3).Value = r.Value
            End If
        Next r
    End With
End Sub

code นี้ สั่งให้คัดลอกลงด้าล่าง
แล้วเราจะเพิ่มด้านขวาอย่างไรครับ

[yodpao.b]

พอดีผมจะใช้สูตร copy ทุกๆเเชลที่มีค่า
นึกได้ใช้ โคด้ด้านบนก็ได้
ด้านบนพิมพ์ผิดครับ
ใช้กับไฟลนี้ครับ

[yodpao.b]

พอดีผมจะใช้สูตร copy ทุกๆเเชลที่มีค่า
นึกได้ใช้ โคด้ด้านบนก็ได้

Code: Select all

Sub Macro1()
    Dim r As Range
    With Sheets(1)
        For Each r In .Range("h4", .Range("h" & .Rows.Count).End(xlUp))
            If r.Value <> "" Then
                r.Offset(0, 3).Value = r.Value
            End If
        Next r
    End With
End Sub

code นี้ สั่งให้คัดลอกลงด้าล่าง
แล้วเราจะเพิ่มด้านขวาอย่างไรครับ

[logic]

ตัวอย่างวนลูปไปขวาครับ ~~> https://www.snasui.com/viewtopic.php?t=5270