รบกวนสอบถามเกียวกับการแยกประเภทสินค้าและ Run ลำดับที่

[niwat2811]

รบกวนสอบถามเกียวกับการแยกประเภทสินค้าและ Run ลำดับที่ ตัวอย่างอยู่ที่ Sheet1 ครับ โดย Run Macro ที่ชื่อ Separate ผ่าน
Macro ชื่อ InsertRow ผ่าน พอถึง Macro ชื่อ ListProduct ไม่ผ่านครับ ค้างแล้วลูกศร Mouse หมุนตลอดเลยครับ
รบกวนท่านอาจารย์หรือผู้รู้ช่วยปรับ Code ให้ด้วยครับ รบกวนเรื่องเรียงลำดับแต่ละประเภทสินค้าให้ด้วยครับ คำตอบที่ต้องการอยู่ที่ Sheet2 ครับ
ขอบคุณทุกท่านครับ

[bank9597]

หากใช้เป็น vba คงต้องรออาจารย์ท่านเข้ามาตอบครับ ซึ่งผมไม่ชำนาญ vba เลย ต้องขออภัยด้วยครับ

[snasui]

พอถึง Macro ชื่อ ListProduct ไม่ผ่านครับ ค้างแล้วลูกศร Mouse หมุนตลอดเลยครับ
รบกวนท่านอาจารย์หรือผู้รู้ช่วยปรับ Code ให้ด้วยครับ รบกวนเรื่องเรียงลำดับแต่ละประเภทสินค้าให้ด้วยครับ คำตอบที่ต้องการอยู่ที่ Sheet2 ครับ
ขอบคุณทุกท่านครับ

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

Code: Select all

Sub ListProduct()
    Range("D30000").End(xlUp).Select
     Do Until ActiveCell.Row = 5
        If ActiveCell.Value = True Then
            ActiveCell.Offset(-1, -2).Value = ActiveCell.Offset(0, -1).Value
            ActiveCell.Offset(0, -3).AutoFill Destination:= _
                Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -1).End(xlDown)) _
                .Offset(0, -2), Type:=xlFillSeries
            ActiveCell.Offset(-1, 0).Select
        Else
            ActiveCell.Offset(-1, 0).Select
        End If
    Loop
End Sub

[niwat2811]

แจ้งผลการทดสอบ Code ที่ท่านอาจารย์ให้มาสามารถใช้ได้ตรงกับความต้องการครับ ขอบคุณมากครับ

[niwat2811]

จาก Code ที่ได้ทดสอบ พบปัญหาตรงที่ว่าถ้า Product ใดมีแค่รายการเดียวจะแสดงผลในการ Run ลำดับที่ได้ไม่ถูกต้องครับ
ผมเลยลองเพิ่ม Macro ที่ชื่อว่า FillNumber แต่ก็ยังแสดงผลได้ไม่ถูกต้องอยู่ดี รบกวนผู้รู้ช่วยชี้แนะด้วยครับ

Code: Select all

Sub FillNumber()
Dim i As Integer
Dim c As Integer
i = 1
Range("A5").End(xlDown).Select
Do Until ActiveCell.Row = 30000
    If ActiveCell.Value = i And ActiveCell.Offset(0, 1) <> "" Then
        ActiveCell.Offset(1, 0).Value = i + 1
        ActiveCell.Offset(1, 0).Select
    Else
        ActiveCell.Offset(1, 0).Select
    End If
Loop
End Sub

[snasui]

แนบไฟล์ตัวอย่างที่มี Product เดียวมาด้วย ระบุปัญหาว่าเป็นอย่างไร คำตอบที่ถูกต้องเป็นอย่างไร จะได้เข้าใจตรงกันครับ

[niwat2811]

ไฟล์แนบครับ

[snasui]

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

Code: Select all

Sub ListProduct()
    Range("D30000").End(xlUp).Select
     Do Until ActiveCell.Row = 5
        If ActiveCell.Value = True Then
            ActiveCell.Offset(-1, -2).Value = ActiveCell.Offset(0, -1).Value
            If ActiveCell.Offset(1, -1) <> "" Then
                ActiveCell.Offset(0, -3).AutoFill Destination:= _
                    Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -1).End(xlDown)) _
                    .Offset(0, -2), Type:=xlFillSeries
            End If
            ActiveCell.Offset(-1, 0).Select
        Else
            ActiveCell.Offset(-1, 0).Select
        End If
    Loop
End Sub

[niwat2811]

ครับ Code ใช้ได้ตรงตามความต้องการแล้วครับ ขอบคุณท่านอาจารย์มากครับ