ต้องการทราบว่า cellใดมีค่าสูงสุดติดต่อกัน 8ค่าให้แสดงเป็น yes

[lotto009]

เรียนอาจารย์และทุกท่าน
ต้องการทราบว่า cellใดมีค่าสูงสุดติดต่อกัน 8ค่าให้แสดงเป็น yes
ส่วน cellใดที่ไม่ติดในนั้นให้แสดงเป็นNo
ต้องใช้สูตรแบบใดครับ ผมใช้ large แต่ว่ามาแค่ค่าสูงสุด
ผมแนบไฟล์มาด้วยนะครับ
ขอบคุณครับ

[lotto009]

ไม่ต้องติดกันครับแค่
-มีค่าสุงสุดทั้งหมดเกิน8ค่าให้เป็น yes
-ถ้าไม่มีถึง 8ค่าให้เป็น no
ชอบพระคุณครับ ผมใช้sum product แต่ไม่ได้ตามต้องการครับ

[lotto009]

ต้องขอโทษจากใจจริงด้วยครับ ผมเข้าใจผิด ผมจะลองเขียน macroแล้วจะ post code อีกทีว่าถูกหรือไม่นะครับ

[lotto009]

เรียนอาจาร์ยครับ
ผมบันทึกmacroไว้แล้วครับ คือต้องการแบบนี้ครับ
ที่Sheet1
-คลิกปุ่มMacroทำการ copyทีละแถวแล้วไปไว้ที่shee2
ที่Sheet2
-เมื่อcopyมาไว้sheet2
-ทำการ Rankingจากมากไปหาน้อย
-ให้ดำเนินการไปเรื่อยๆจนหมดข้อมูลจากsheet1ครับ
-ผมมีข้อมูลที่ sheet1 ประมาณ 20000แถวครับ
ขอบพระคุณมากครับ

[niwat2811]

ลองแบบนี้ดูว่าได้ตามต้องการไหมครับ

Code: Select all

Sub test()
Dim lr As Long
lr = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:L" & lr).Copy
Sheets("Sheet2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
lr = Range("A" & Rows.Count).End(xlUp).Row
With Range("A1:A" & lr)
    .Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
End With
With Range("B1:B" & lr)
    .Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
End With
With Range("C1:C" & lr)
    .Sort Key1:=Range("C1"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
End With
With Range("D1:D" & lr)
    .Sort Key1:=Range("D1"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
End With
With Range("E1:E" & lr)
    .Sort Key1:=Range("E1"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
End With
End Sub

[niwat2811]

ขอโทษทีครับอ่านโจทย์ไม่ละเอียด
ถ้าชีท 1 มีข้อมูลประมาณ 20000 กว่าบรรทัด
ถ้า copy ไปวางที่ชีท 2 โดยวางแบบ Transpose น่าจะวางได้ไม่หมดในชีทเดียวนะครับ
เพราะว่าหนึ่งชีทน่าจะมีคอลัมภน์มากสุดได้แค่ 16000 กว่าคอลัมภน์

Code: Select all

Sub test1()
Dim lr As Long
Dim ColumnCount As Long
lr = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:L" & lr).Copy
Sheets("Sheet2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
ColumnCount = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To ColumnCount
    Columns(i).Sort Key1:=Cells(1, i), _
    Order1:=xlDescending, _
    Header:=xlYes, _
    OrderCustom:=1, _
    MatchCase:=False, _
    Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
Next i
End Sub

[lotto009]

ช่วยอธิบายcodeหน่อยได้ใหมครับ ตอนนี้ทำได้แล้วครับ แต่อย่างที่แจ้งไว้มากสุดได้แค่1600
-ขออนุญาตเปลี่ยนได้ใหมครับ
-กรณีต้องการเรียงลำดับจากมากไปหาน้อยในRow เดิม(แนวยาว)ของ sheet1ต้องเขียนdimแบบใหนครับ
ขอบคุณครับ

[niwat2811]

ลองแบบนี้ดูครับว่าได้ตามต้องการไหม

Code: Select all

Sub Sort_Rows()

Dim lr As Long, lc As Long, i As Integer

lr = Cells(Rows.Count, 1).End(xlUp).Row

lc = Cells(1, Columns.Count).End(xlToLeft).Column

For i = 2 To lr

    Range(Cells(i, 2), Cells(lr, lc)).Sort Key1:=Cells(i, 2), Order1:=xlDescending, _
        Header:=xlYes, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal

Next i

End Sub

[lotto009]

ขอบคุณมากครับ ได้ตามต้องการแล้วครับ
ช่วยอธิบายcodeให้ด้วยนะครับ
+++ ให้เลยครับ

[snasui]

ควรถามเฉพาะที่ไม่เข้าใจ จะได้อธิบายเป็นส่วน ๆ ไป การใช้งาน VBA จะต้องศึกษาให้ทราบพื้นฐานมาบ้างครับ

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

[lotto009]

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

[lotto009]

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