ต้องการได้ผลลัพธ์ที่ไวขึ้นโดยไม่ใช้ Loop หรือถ้าใช้ต้องปรับอย่างไรให้ได้ผลลัพธ์ที่ไวขึ้น
Posted: Sun Dec 03, 2023 7:14 am
สมมติมีข้อมูลดิบดังนี้
ซึ่งโค้ด vba ที่ผลใช้คือ
มันทำงานได้ถูกต้องตามต้องการทุกประการ แต่ถ้ามีชุดข้อมูลหลายๆแถว เช่น 100 แถวมันทำงานได้ช้ามาก เพราะมันทำทีละคำสั่ง ทีละบรรทัด ผลต้องปรับโค้ด หรือใช้โค้ดใดใน VBA เพื่อให้ได้ผลลัพธ์แบบเดียวกันแต่ใช้เวลาประมวลผลที่ไว และรวดเร็ว ต้องปรับเปลี่ยนแก้โค้ดอย่างไรครับ
Code: Select all
ผลคะแนน
3/12/2023
วิ่งผลัด
10|10
ชักเย่อ
5|10
กระโดดตบ
3|10
ดันพื้น
4|10
หกกบ
6|10
โหนบาร์
8|10
Code: Select all
Sub CopyCDataToNextColumn()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim data As Variant
data = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 1)).value
Dim i As Long
For i = 1 To UBound(data, 1)
If InStr(1, data(i, 1), "|", vbTextCompare) > 0 Then
Dim value As String
value = Replace(data(i, 1), "|", "-")
ws.Cells(i - 1, 2).value = value
ws.Cells(i, 1).value = ""
End If
Next i
Dim j As Long
j = 1 ' Start from the first row
Do While j <= lastRow
If ws.Cells(j, 1).value = "" Then
' If an empty cell is found, delete the entire row
ws.Rows(j).Delete
lastRow = lastRow - 1 ' Update the lastRow
Else
j = j + 1 ' Move to the next row
End If
Loop
Dim k As Long
k = 1 ' Start from the first row
Do While k <= lastRow
If InStr(1, ws.Cells(k, 1).value, "ผลคะแนน", vbTextCompare) > 0 Or IsDate(ws.Cells(k, 1).value) Then
' If "ผลคะแนน" is found in the cell, delete the entire row
ws.Rows(k).Delete
lastRow = lastRow - 1 ' Update the lastRow
Else
k = k + 1 ' Move to the next row
End If
Loop
End Sub